Versioned Metadata

docs/changelog/7.x.x.txt

@@ -5,6 +5,8 @@
  - fixed #12043: Collaboration Systems don't pull mail that fast!
  - fixed #12044: Spectre::Cron and non-integer time units
  - fixed #12046: Empty AssetProxy creates infinite loop (Dale Trexel)
+ - Metadata is now versioned
+ - Metadata fields can be restricted by asset class
 
 7.10.9
  - fixed #12030: Calendar Feed Time Zone Issue

docs/gotcha.txt

@@ -7,6 +7,10 @@ upgrading from one version to the next, or even between multiple
 versions. Be sure to heed the warnings contained herein as they will
 save you many hours of grief.
 
+7.10.10
+--------------------------------------------------------------------
+    * Asset metadata is now versioned.
+
 7.10.9
 --------------------------------------------------------------------
     * WebGUI now depends on Data::ICal for making and reading iCal feeds

docs/upgrades/upgrade_7.10.9-7.10.10.pl

@@ -32,7 +32,7 @@ my $session = start(); # this line required
 
 # upgrade functions go here
 convertCsMailInterval($session);
-
+addVersioningToMetadata($session);
 finish($session); # this line required
 
 
@@ -72,6 +72,25 @@ sub convertCsMailInterval {
     print "DONE!\n" unless $quiet;
 }
 
+sub addVersioningToMetadata {
+    my $session = shift;
+    print "\tAltering metadata tables for versioning..." unless $quiet;
+    my $db = $session->db;
+    $db->write(q{
+        alter table metaData_values
+            add column revisionDate bigint,
+            drop primary key,
+            add primary key (fieldId, assetId, revisionDate);
+    });
+    $db->write(q{
+        create table metaData_classes (
+            className char(255),
+            fieldId   char(22)
+        );
+    });
+    print "DONE!\n" unless $quiet;
+}
+
 
 # -------------- DO NOT EDIT BELOW THIS LINE --------------------------------
 

lib/WebGUI/Asset/Shortcut.pm

@@ -621,7 +621,8 @@ sub getShortcutByCriteria {
 
         	my $replacement = $expression;	# We don't want to modify $expression.
 						# We need it later.
-		push(@joins," left join metaData_values ".$counter."_v on a.assetId=".$counter."_v.assetId ");
+		my $alias = $counter . '_v';
+		push(@joins," left join metaData_values $alias on a.assetId=$alias.assetId and d.revisionDate = $alias.revisionDate ");
 		# Get the field (State) and the value (Wisconsin) from the $expression.
 	        $expression =~ /($attribute)\s*($operator)\s*($attribute)/gi;
 	        my $field = $1;
@@ -654,7 +655,12 @@ sub getShortcutByCriteria {
 	}
 
 	my $sql = "select a.assetId from asset a
-			".join("\n", @joins)."
+               left join assetData d on a.assetId = d.assetId
+                   and d.revisionDate=(
+                       select max(revisionDate)
+                       from assetData d2
+                       where d2.assetId = a.assetId
+                   ) ".join("\n", @joins)."
 			where a.className = ".$db->quote($self->getShortcutDefault->get("className"));
 	# Add constraint only if it has been modified.
 	$sql .= " and ".$constraint if (($constraint ne $criteria) && $constraint ne "");

lib/WebGUI/Asset/Story.pm

@@ -429,6 +429,9 @@ sub getEditForm {
                             value => $i18n->get('save and add another photo'),
                           }),
     };
+    if ($session->setting->get('metaDataEnabled')) {
+        $var->{metadata} = $self->getMetaDataAsFormFields;
+    }
     $var->{ photo_form_loop } = [];
     ##Provide forms for the existing photos, if any
     ##Existing photos get a delete Yes/No.

lib/WebGUI/AssetClipboard.pm

@@ -182,11 +182,12 @@ sub duplicate {
     }
     # Duplicate metadata fields
     my $sth = $self->session->db->read(
-        "select * from metaData_values where assetId = ?", 
+        "select * from metaData_values where assetId = ? and revisionDate = ?",
-        [$self->getId]
+        [$self->getId, $self->get('revisionDate')]
     );
     while (my $h = $sth->hashRef) {
-        $self->session->db->write("insert into metaData_values (fieldId, assetId, value) values (?, ?, ?)", [$h->{fieldId}, $newAsset->getId, $h->{value}]);
+        $self->session->db->write("insert into metaData_values (fieldId,
+            assetId, revisionDate, value) values (?, ?, ?, ?)", [$h->{fieldId}, $newAsset->getId, $newAsset->get('revisionDate'), $h->{value}]);
     }
 
     # Duplicate keywords

lib/WebGUI/AssetMetaData.pm

@@ -39,7 +39,8 @@ These methods are available from this class:
 
 =head2 addMetaDataField ( )
 
-Adds a new field to the metadata system, or edit an existing one.
+Adds a new field to the metadata system, or edit an existing one. The id of
+the field is returned.
 
 =head3 fieldId
 
@@ -67,6 +68,10 @@ The form field type for metaData: selectBox, text, integer, or checkList, yesNo,
 For fields that provide options, the list of options.  This is a string with
 newline separated values.
 
+=head3 classes
+
+An arrayref of classnames that this metadata field applies to
+
 =cut
 
 sub addMetaDataField {
@@ -78,18 +83,31 @@ sub addMetaDataField {
     my $description      = shift || '';
     my $fieldType        = shift;
     my $possibleValues   = shift;
+    my $classes          = shift;
+    my $db               = $self->session->db;
 
 	if($fieldId eq 'new') {
 		$fieldId = $self->session->id->generate();
-		$self->session->db->write("insert into metaData_properties (fieldId, fieldName, defaultValue, description, fieldType, possibleValues) values (?,?,?,?,?,?)",
+		$db->write("insert into metaData_properties (fieldId, fieldName, defaultValue, description, fieldType, possibleValues) values (?,?,?,?,?,?)",
             [ $fieldId, $fieldName, $defaultValue, $description, $fieldType, $possibleValues, ]
         );
 	}
     else {
-        $self->session->db->write("update metaData_properties set fieldName = ?, defaultValue = ?, description = ?, fieldType = ?, possibleValues = ? where fieldId = ?",
+        $db->write("update metaData_properties set fieldName = ?, defaultValue = ?, description = ?, fieldType = ?, possibleValues = ? where fieldId = ?",
             [ $fieldName, $defaultValue, $description, $fieldType, $possibleValues, $fieldId, ]
         );
+        $db->write('delete from metaData_classes where fieldId=?', [$fieldId]);
 	}
+
+    if ($classes && @$classes) {
+        my $qfid = $db->quote($fieldId);
+        $db->write('insert into metaData_classes (fieldId, className) values '
+            .join(', ',
+            map { my $q = $db->quote($_); "($qfid, $q)" } @$classes
+        ));
+    }
+
+    return $fieldId;
 }
 
 
@@ -108,12 +126,57 @@ The fieldId to be deleted.
 sub deleteMetaDataField {
     my $self = shift;
     my $fieldId = shift;
-    $self->session->db->beginTransaction;
+    my $db = $self->session->db;
-    $self->session->db->write("delete from metaData_properties where fieldId = ?",[$fieldId]);
+    $db->beginTransaction;
-    $self->session->db->write("delete from metaData_values where fieldId = ?",[$fieldId]);
+    for my $table (map { "metaData_$_" } qw(properties values classes)) {
-    $self->session->db->commit;
+        $db->write("delete from $table where fieldId = ?", [ $fieldId ]);
+    }
+    $db->commit;
 }
 
+#-------------------------------------------------------------------
+
+=head2 getMetaDataAsFormFields
+
+Returns a hashref of metadata field names WebGUI::Form objects appropriate
+for use on edit forms.
+
+=cut
+
+sub getMetaDataAsFormFields {
+    my $self    = shift;
+    my $session = $self->session;
+    my $i18n    = WebGUI::International->new($session, 'Asset');
+    my $fields  = $self->getMetaDataFields;
+    my %hash;
+    for my $fid (keys %$fields) {
+        my $info    = $fields->{$fid};
+        my $type    = lcfirst ($info->{fieldType} || 'text');
+        my $name    = $info->{fieldName};
+        my $options = $info->{possibleValues};
+        if($type eq 'selectBox') {
+            my $label = $i18n->get('Select');
+            $options = "|$label\n$options";
+        }
+        my $formClass = ucfirst $type;
+        $hash{$name} = WebGUI::Pluggable::instanciate(
+            "WebGUI::Form::$formClass",
+            'new',
+            [
+                $session, {
+                    name         => "metadata_$fid",
+                    label        => $name,
+                    value        => $info->{value},
+                    extras       => qq'title="$info->{description}"',
+                    defaultValue => $info->{defaultValue},
+                    fieldType    => $type,
+                    options      => $options,
+                }
+            ]
+        )->toHtml;
+    };
+    \%hash;
+}
 
 #-------------------------------------------------------------------
 
@@ -139,21 +202,11 @@ sub getMetaDataAsTemplateVariables {
 
 #-------------------------------------------------------------------
 
-=head2 getMetaDataFields ( [fieldId] )
+sub _getMetaDataFieldsHelper {
-
-Returns a hash reference containing all metadata field properties for this Asset.
-You can limit the output to a certain field by specifying a fieldId.
-
-=head3 fieldId
-
-If specified, the hashRef will contain only this field.
-
-=cut
-
-sub getMetaDataFields {
 	my $self    = shift;
 	my $fieldId = shift;
-    my $session = $self->session;
+	my $listAll = shift || $fieldId;
+	my $db      = $self->session->db;
 	my $sql = "select
 		 	f.fieldId, 
 			f.fieldName, 
@@ -163,19 +216,76 @@ sub getMetaDataFields {
 			f.possibleValues,
 			d.value
 		from metaData_properties f
-		left join metaData_values d on f.fieldId=d.fieldId and d.assetId=".$session->db->quote($self->getId);
+        left join metaData_values d
-	$sql .= " where f.fieldId = ".$session->db->quote($fieldId) if ($fieldId);
+            on f.fieldId=d.fieldId
-	$sql .= " order by f.fieldName";
+            and d.assetId=?
-	if ($fieldId) {
+            and d.revisionDate = ?
-		return $session->db->quickHashRef($sql);	
+        ";
-	}
+
-    else {
+    my @where;
-        tie my %hash, 'Tie::IxHash';
+    my @place = ($self->getId, $self->get('revisionDate'));
-        %hash = %{ $session->db->buildHashRefOfHashRefs($sql, [], 'fieldId') };
+    unless ($listAll) {
-        return \%hash;
+        # Either there's no class info stored for this field or this class is
-	}
+        # one of them.
+        push @where, q{
+            not exists (
+                select * from metaData_classes where fieldId = f.fieldId
+            )
+            or exists (
+                select *
+                from metaData_classes
+                where className = ?
+                    and fieldId = f.fieldId
+            )
+        };
+        push @place, ref $self;
+    }
+
+    if ($fieldId) {
+        push @where, 'f.fieldId = ?';
+        push @place, $fieldId;
+    }
+
+    if (@where) {
+        $sql .= 'where ' . join(' AND ', map { "($_)" } @where);
+    }
+
+    my $hash = $db->buildHashRefOfHashRefs( $sql, \@place, 'fieldId' );
+
+    return $fieldId ? $hash->{$fieldId} : $hash;
 }
 
+#-------------------------------------------------------------------
+
+=head2 getAllMetaDataFields
+
+getMetaDataFields without bothering about whether they apply to this class.
+
+=cut
+
+sub getAllMetaDataFields {
+    my $self = shift;
+    return $self->_getMetaDataFieldsHelper(undef, 1);
+}
+
+#-------------------------------------------------------------------
+
+=head2 getMetaDataFields ( [fieldId] )
+
+Returns a hash reference containing all metadata field properties for this Asset.
+You can limit the output to a certain field by specifying a fieldId.
+
+=head3 fieldId
+
+If specified, the hashRef will contain only this field. In this case, you will
+get that metadata field if it exists whether it applies to this asset or not.
+
+=cut
+
+sub getMetaDataFields {
+    my ($self, $fieldId) = @_;
+    return $self->_getMetaDataFieldsHelper($fieldId);
+}
 
 #-------------------------------------------------------------------
 
@@ -197,17 +307,10 @@ sub updateMetaData {
 	my $self = shift;
 	my $fieldId = shift;
 	my $value = shift;
-	my $db = $self->session->db;
+    $self->session->db->write(
-	my ($exists) = $db->quickArray("select count(*) from metaData_values where assetId = ? and fieldId = ?",[$self->getId, $fieldId]);
+        'replace into metaData_values (fieldId, assetId, revisionDate, value) values (?, ?, ?, ?)',
-    if (!$exists && $value ne "") {
+        [$fieldId, $self->getId, $self->get('revisionDate'), $value]
-        $db->write("insert into metaData_values (fieldId, assetId) values (?,?)",[$fieldId, $self->getId]);
+    );
-    }
-    if ($value  eq "") { # Keep it clean
-        $db->write("delete from metaData_values where assetId = ? and fieldId = ?",[$self->getId, $fieldId]);
-    }
-    else {
-        $db->write("update metaData_values set value = ? where assetId = ? and fieldId=?", [$value, $self->getId, $fieldId]);
-    }
 }
 
 
@@ -277,6 +380,44 @@ sub www_editMetaDataField {
 		-value=>$fieldInfo->{fieldType} || "text",
 		-types=> [ qw /text integer yesNo selectBox radioList checkList/ ]
 	);
+
+    my $default = WebGUI::Asset->definition($self->session)->[0]->{assetName};
+    my %classOptions;
+    # usedNames maps a name to a class. If a name exists there, it has been
+    # used.  If it maps to a classname, that classname needs to be renamed.
+    my %usedNames;
+    for my $class (WebGUI::Pluggable::findAndLoad('WebGUI::Asset')) {
+        next unless $class->isa('WebGUI::Asset');
+        my $name  = $class->definition($self->session)->[0]->{assetName};
+        next unless $name; # abstract classes (e.g. wobject) don't have names
+
+        # We don't want things named "Asset".
+        if ($name eq $default) {
+            $name = $class;
+        }
+        elsif (exists $usedNames{$name}) {
+            if (my $rename = $usedNames{$name}) {
+                $classOptions{$rename} = "$name ($rename)";
+                undef $usedNames{$name};
+            }
+            $name = "$name ($class)";
+        }
+        $usedNames{$name} = $class;
+        $classOptions{$class} = $name;
+    }
+
+    $f->selectList(
+        name         => 'classes',
+        label        => $i18n->get('Allowed Classes'),
+        hoverHelp    => $i18n->get('Allowed Classes hoverHelp'),
+        options      => \%classOptions,
+        defaultValue => $fid ne 'new' && $self->session->db->buildArrayRef(
+            'select className from metaData_classes where fieldId = ?',
+            [ $fid ]
+        ),
+        sortByValue  => 1,
+    );
+
 	$f->textarea(
 		-name=>"possibleValues",
 		-label=>$i18n->get(487),
@@ -330,6 +471,7 @@ sub www_editMetaDataFieldSave {
         $self->session->form->process("description") || '',
         $self->session->form->process("fieldType"),
         $self->session->form->process("possibleValues"),
+        [ $self->session->form->process("classes") ],
     );
 
 	return $self->www_manageMetaData; 
@@ -351,7 +493,7 @@ sub www_manageMetaData {
 	my $i18n = WebGUI::International->new($self->session,"Asset");
 	$ac->addSubmenuItem($self->getUrl('func=editMetaDataField'), $i18n->get("Add new field"));
 	my $output;
-	my $fields = $self->getMetaDataFields();
+	my $fields = $self->getAllMetaDataFields;
 	foreach my $fieldId (keys %{$fields}) {
 		$output .= $self->session->icon->delete("func=deleteMetaDataField;fid=".$fieldId,$self->get("url"),$i18n->get('deleteConfirm'));
 		$output .= $self->session->icon->edit("func=editMetaDataField;fid=".$fieldId,$self->get("url"));

lib/WebGUI/AssetVersioning.pm

@@ -150,6 +150,23 @@ sub addRevision {
             );
         }
     }
+
+    # Copy metadata values
+    my $db    = $self->session->db;
+    my $id    = $self->getId;
+    my $then  = $self->get('revisionDate');
+    my $mdget = q{
+        select fieldId, value from metaData_values
+        where assetId = ? and revisionDate = ?
+    };
+    my $mdset = q{
+        insert into metaData_values (fieldId, value, assetId, revisionDate)
+        values (?, ?, ?, ?)
+    };
+    for my $row (@{ $db->buildArrayRefOfHashRefs($mdget, [ $id, $then ]) }) {
+        $db->write($mdset, [ $row->{fieldId}, $row->{value}, $id, $now ]);
+    }
+
     $self->session->db->commit;
 	
 	# merge the defaults, current values, and the user set properties
@@ -377,6 +394,10 @@ sub purgeRevision {
 		if ($count < 1) {
 			$self->session->db->write("update asset set isLockedBy=null where assetId=?",[$self->getId]);
 		}
+		$self->session->db->write(
+			'delete from metaData_values where assetId=?  and revisionDate=?',
+			[ $self->getId, $self->get('revisionDate') ]
+		);
         	$self->session->db->commit;
 		$self->purgeCache;
 		$self->updateHistory("purged revision ".$self->get("revisionDate"));

lib/WebGUI/Workflow/Activity/SendNewsletters.pm

@@ -99,9 +99,20 @@ sub execute {
             $eh->info("Found subscription $subscription");
             my ($fieldId, $value) = split("~", $subscription);
             $eh->info("Searching for threads that match $subscription");
-            my $matchingThreads = $db->read("select metaData_values.assetId from metaData_values
+            my $matchingThreads = $db->read("
-                left join asset using (assetId) where fieldId=? and value like ? and creationDate > ?
+                select mv.assetId
-                and className like ?  and lineage like ? and state = ?", 
+                from metaData_values mv
+                left join asset a using (assetId)
+                left join assetData d on
+                    mv.assetId = d.assetId
+                    and mv.revisionDate = d.revisionDate
+                    and d.revisionDate = (
+                        select max(revisionDate)
+                        from assetData d2
+                        where d2.assetId = d.assetId
+                    )
+                where mv.fieldId=? and mv.value like ? and a.creationDate > ?
+                and a.className like ? and a.lineage like ? and a.state = ?",
                 [$fieldId, '%'.$value.'%', $lastTimeSent, 'WebGUI::Asset::Post::Thread%', $newsletter->get("lineage").'%', 'published']); 
             while (my ($threadId) = $matchingThreads->array) {
                 next

lib/WebGUI/i18n/English/Asset.pm

@@ -1409,6 +1409,14 @@ Couldn't open %-s because %-s <br />
         context     => q{Class, as in name of class, or type of asset},
     },
 
+    'Allowed Classes' => {
+        message     => 'Allowed Classes',
+        lastUpdated => 1295986062,
+    },
+    'Allowed Classes hoverHelp' => {
+        message     => 'Which assets use this metadata?',
+        lastUpdated => 1295986062,
+    }
 };
 
 1;

sbin/testEnvironment.pl

@@ -64,7 +64,7 @@ my $missingModule = 0;
 checkModule("LWP",                          5.833        );
 checkModule("HTTP::Request",                1.40         );
 checkModule("HTTP::Headers",                1.61         );
-checkModule("Test::More",                   0.82,      2 );
+checkModule("Test::More",                   0.96,      2 );
 checkModule("Test::MockObject",             1.02,      2 );
 checkModule("Test::Deep",                   0.095,       );
 checkModule("Test::LongString",             0.13,      2 );

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;