Versioned Metadata

t/Asset/AssetMetaData.t

@@ -16,6 +16,7 @@ use lib "$FindBin::Bin/../lib";
 ##versions.
 
 use WebGUI::Test;
+use WebGUI::Test::Metadata;
 use WebGUI::Session;
 use WebGUI::Utility;
 use WebGUI::Asset;
@@ -23,7 +24,7 @@ use WebGUI::VersionTag;
 
 use Test::More; # increment this value for each test you create
 use Test::Deep;
-plan tests => 13;
+plan tests => 16;
 
 my $session = WebGUI::Test->session;
 $session->user({userId => 3});
@@ -74,6 +75,21 @@ WebGUI::Test->addToCleanup(sub {
 cmp_deeply({}, $snippet->getMetaDataFields, 'snippet has no metadata fields');
 cmp_deeply({}, $folder->getMetaDataFields,  'folder has no metadata fields');
 
+subtest 'Field with class data' => sub {
+    my $meta = WebGUI::Test::Metadata->new(
+        $folder, {
+            classes => ['WebGUI::Asset::Wobject::Folder']
+        }
+    );
+    my $id = $meta->fieldId;
+    my $snips = $snippet->getMetaDataFields;
+    my $folds = $folder->getMetaDataFields;
+    ok !exists $snips->{$id}, 'snippet does not have field';
+    ok exists $folds->{$id}, 'but folder does';
+    $snips = $snippet->getAllMetaDataFields;
+    ok exists $snips->{$id}, 'snips returns data with getAll';
+};
+
 $snippet->addMetaDataField('new', 'searchEngine', '', 'Search Engine preference', 'text');
 
 my @snipKeys;
@@ -223,6 +239,71 @@ cmp_deeply(
     'getMetaDataAsTemplateVariables returns proper values for folder'
 );
 
+{
+    my $asset = $root->addChild(
+        {
+            className => 'WebGUI::Asset::Snippet',
+        }
+    );
+    WebGUI::Test->addToCleanup($asset);
+    my $meta = WebGUI::Test::Metadata->new($asset);
+    my $ff = $asset->getMetaDataAsFormFields;
+    like $ff->{$meta->fieldName}, qr/input/, 'getMetaDataAsFormFields';
+}
+
+# check that asset metadata versioning works properly
+subtest 'asset metadata versioning' => sub {
+    my $asset = WebGUI::Asset->getImportNode($session)->addChild(
+        {
+            className => 'WebGUI::Asset::Snippet',
+        }
+    );
+    WebGUI::Test->addToCleanup($asset);
+    my $meta = WebGUI::Test::Metadata->new($asset);
+    $meta->update('version one');
+    sleep 1;
+    my $rev2 = $asset->addRevision();
+    is $meta->get(), 'version one', 'v1 for 1';
+    is $meta->get($rev2), 'version one', 'v1 for 2';
+    $meta->update('version two', $rev2);
+    is $meta->get($rev2), 'version two', 'v2 has been set';
+    is $meta->get(), 'version one', 'v1 has not been changed';
+
+    my $dup = $asset->duplicate;
+
+    my $db    = $session->db;
+    my $count_rev = sub {
+        my $a = shift;
+        my $sql = q{
+            select count(*)
+            from metaData_values
+            where assetId = ? and revisionDate = ?
+        };
+        $db->quickScalar( $sql, [ $a->getId, $a->get('revisionDate') ] );
+    };
+    my $count_all = sub {
+        my $a = shift;
+        my $sql = 'select count(*) from metaData_values where assetId = ?';
+        $db->quickScalar( $sql, [ $a->getId ] );
+    };
+
+    is $count_all->($asset), 2, 'two values for original';
+    is $count_all->($dup), 1, 'one value for dup';
+
+    is $count_rev->($asset), 1, 'one value for v1';
+    is $count_rev->($rev2), 1, 'one value for v2';
+
+    $rev2->purgeRevision;
+
+    note 'after purge';
+
+    is $count_rev->($asset), 1, 'one value for v1';
+    is $count_rev->($rev2), 0, 'no value for v2';
+
+    is $count_all->($asset), 1, 'one value for original';
+    is $count_all->($dup), 1, 'one value for dup';
+};
+
 sub buildNameIndex {
     my ($fidStruct) = @_;
     my $nameStruct;

t/Asset/Shortcut/030-basic-criteria.t

@@ -0,0 +1,75 @@
+use warnings;
+use strict;
+
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Test::More;
+use WebGUI::Test;
+use WebGUI::Test::Metadata;
+
+use WebGUI::Asset;
+
+my $session = WebGUI::Test->session;
+my $root = WebGUI::Asset->getImportNode($session);
+
+sub asset {
+    my $asset = $root->addChild({ @_ });
+    WebGUI::Test->addToCleanup($asset);
+    return $asset;
+}
+
+my $state  = WebGUI::Test::Metadata->new($root, fieldName => 'State');
+my $county = WebGUI::Test::Metadata->new($root, fieldName => 'County');
+
+my $snip = asset className => 'WebGUI::Asset::Snippet';
+
+sub town {
+    my ($t, $c, $s) = @_;
+    sleep 1; #for different creation dates
+    my $a = asset(className => 'WebGUI::Asset::Snippet', title => $t);
+    $state->update($s, $a);
+    $county->update($c, $a);
+    return $a;
+}
+
+sub town_is {
+    my ($got, $expected, $message) = @_;
+    if ($got->getId eq $expected->getId) {
+        pass($message);
+    }
+    else {
+        fail($message);
+        diag <<DIAG;
+          got: ${ \$got->getTitle }
+     expected: ${ \$expected->getTitle }
+DIAG
+    }
+}
+
+my $grafton   = town qw(Grafton Ozaukee Wisconsin);
+my $baraboo   = town qw(Baraboo Sauk Wisconsin);
+my $centralia = town qw(Centralia Lewis Washington);
+my $seattle   = town qw(Seattle King Washington);
+
+my $short = asset
+    className          => 'WebGUI::Asset::Shortcut',
+    shortcutToAssetId  => $snip->getId,
+    disableContentLock => 1;
+
+sub match {
+    $short->update({ shortcutCriteria => shift });
+    $short->getShortcutByCriteria;
+}
+
+plan tests => 4;
+
+town_is match('State = Wisconsin and County != Sauk'), $grafton;
+town_is match('State != Washington'), $baraboo;
+town_is match('County = Lewis'), $centralia;
+town_is match('County != Sauk'), $seattle;
+
+# If we don't undef these explicitly, destruction order doesn't happen right
+# because of closure in town()
+undef $state;
+undef $county;

t/lib/WebGUI/Test/Metadata.pm

@@ -0,0 +1,119 @@
+package WebGUI::Test::Metadata;
+
+use warnings;
+use strict;
+
+=head1 NAME
+
+WebGUI::Test::Metadata
+
+=head1 SYNOPSIS
+
+    use WebGUI::Test::Metadata;
+
+    my $meta = WebGUI::Test::Metadata->new( $asset, fieldName => 'Foobar' );
+    my $type = $meta->fieldType;
+    undef $meta; # or just let it go out of scope, whatever suits you
+
+=head1 METHODS
+
+=cut
+
+#----------------------------------------------------------------------------
+
+=head1 DESTROY
+
+When this object goes out of scope, the metadata field will be cleaned up.
+
+=cut
+
+sub DESTROY {
+    my $self = shift;
+    $self->{asset}->deleteMetaDataField($self->fieldId)
+}
+
+#----------------------------------------------------------------------------
+
+=head1 get ([ $asset ])
+
+Gets the value of this metadata field for the asset you passed in (or the one
+you passed to new).
+
+=cut
+
+sub get {
+    my ($self, $asset) = @_;
+    $asset ||= $self->{asset};
+    return $asset->getMetaDataFields($self->fieldId)->{value};
+}
+#----------------------------------------------------------------------------
+
+=head1 new ($asset, %args)
+
+Needs some kind of asset (any old asset will do), and if you want to override
+any of the arguments to addMetaDataField, name them in the args hash.
+
+=cut
+
+sub new {
+    my $class = shift;
+    my $asset = shift;
+    my $args  = @_ == 1 ? $_[0] : { @_ };
+    my $id = $asset->addMetaDataField(
+        $args->{fieldId},
+        $args->{fieldName},
+        $args->{defaultValue}   || '',
+        $args->{description}    || '',
+        $args->{fieldType}      || 'text',
+        $args->{possibleValues} || '',
+        $args->{classes},
+    );
+
+    bless {
+        asset => $asset,
+        info  => $asset->getMetaDataFields($id),
+    }, $class;
+}
+
+#----------------------------------------------------------------------------
+
+=head1 update ($value, [ $asset ])
+
+Sets the value of this metadata field for the asset you passed in (or the one
+you passed to new).
+
+=cut
+
+sub update {
+    my ($self, $value, $asset) = @_;
+    $asset ||= $self->{asset};
+    $asset->updateMetaData($self->fieldId => $value);
+}
+
+=head1 OTHER METHDOS
+
+fieldId, fieldName, description, defaultvalue, fieldType and possibleValues
+are all available as methods. They'll get you what getMetaDataFields would
+return you.
+
+=cut
+
+BEGIN {
+    for my $key (
+        qw(
+            fieldId
+            fieldName
+            description
+            defaultValue
+            fieldType
+            possibleValues
+        )
+    )
+    {
+        my $accessor = sub { $_[0]->{info}->{$key} };
+        no strict 'refs';
+        *{__PACKAGE__ . "::$key"} = $accessor;
+    }
+}
+
+1;