diff --git a/docs/changelog/7.x.x.txt b/docs/changelog/7.x.x.txt
index 33d4f8784..9f7180b1d 100644
--- a/docs/changelog/7.x.x.txt
+++ b/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
diff --git a/docs/gotcha.txt b/docs/gotcha.txt
index 5b5e44eb0..a7b2f20d8 100644
--- a/docs/gotcha.txt
+++ b/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
diff --git a/docs/upgrades/upgrade_7.10.9-7.10.10.pl b/docs/upgrades/upgrade_7.10.9-7.10.10.pl
index 949801e8e..8076a8e85 100644
--- a/docs/upgrades/upgrade_7.10.9-7.10.10.pl
+++ b/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 --------------------------------
diff --git a/lib/WebGUI/Asset/Shortcut.pm b/lib/WebGUI/Asset/Shortcut.pm
index c2a62051d..3929d1a6c 100644
--- a/lib/WebGUI/Asset/Shortcut.pm
+++ b/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 "");
diff --git a/lib/WebGUI/Asset/Story.pm b/lib/WebGUI/Asset/Story.pm
index 8b1219b44..b8b515455 100644
--- a/lib/WebGUI/Asset/Story.pm
+++ b/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.
diff --git a/lib/WebGUI/AssetClipboard.pm b/lib/WebGUI/AssetClipboard.pm
index 15225276b..717e2974f 100644
--- a/lib/WebGUI/AssetClipboard.pm
+++ b/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 = ?",
- [$self->getId]
+ "select * from metaData_values where assetId = ? and revisionDate = ?",
+ [$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
diff --git a/lib/WebGUI/AssetMetaData.pm b/lib/WebGUI/AssetMetaData.pm
index 76e59da6f..e548b5fbb 100644
--- a/lib/WebGUI/AssetMetaData.pm
+++ b/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;
- $self->session->db->write("delete from metaData_properties where fieldId = ?",[$fieldId]);
- $self->session->db->write("delete from metaData_values where fieldId = ?",[$fieldId]);
- $self->session->db->commit;
+ my $db = $self->session->db;
+ $db->beginTransaction;
+ for my $table (map { "metaData_$_" } qw(properties values classes)) {
+ $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] )
-
-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 {
+sub _getMetaDataFieldsHelper {
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);
- $sql .= " where f.fieldId = ".$session->db->quote($fieldId) if ($fieldId);
- $sql .= " order by f.fieldName";
- if ($fieldId) {
- return $session->db->quickHashRef($sql);
- }
- else {
- tie my %hash, 'Tie::IxHash';
- %hash = %{ $session->db->buildHashRefOfHashRefs($sql, [], 'fieldId') };
- return \%hash;
- }
+ left join metaData_values d
+ on f.fieldId=d.fieldId
+ and d.assetId=?
+ and d.revisionDate = ?
+ ";
+
+ my @where;
+ my @place = ($self->getId, $self->get('revisionDate'));
+ unless ($listAll) {
+ # 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;
- my ($exists) = $db->quickArray("select count(*) from metaData_values where assetId = ? and fieldId = ?",[$self->getId, $fieldId]);
- if (!$exists && $value ne "") {
- $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]);
- }
+ $self->session->db->write(
+ 'replace into metaData_values (fieldId, assetId, revisionDate, value) values (?, ?, ?, ?)',
+ [$fieldId, $self->getId, $self->get('revisionDate'), $value]
+ );
}
@@ -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"));
diff --git a/lib/WebGUI/AssetVersioning.pm b/lib/WebGUI/AssetVersioning.pm
index 84211c584..00750258c 100644
--- a/lib/WebGUI/AssetVersioning.pm
+++ b/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"));
diff --git a/lib/WebGUI/Workflow/Activity/SendNewsletters.pm b/lib/WebGUI/Workflow/Activity/SendNewsletters.pm
index e267e23a5..e68eb6402 100644
--- a/lib/WebGUI/Workflow/Activity/SendNewsletters.pm
+++ b/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
- left join asset using (assetId) where fieldId=? and value like ? and creationDate > ?
- and className like ? and lineage like ? and state = ?",
+ my $matchingThreads = $db->read("
+ select mv.assetId
+ 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
diff --git a/lib/WebGUI/i18n/English/Asset.pm b/lib/WebGUI/i18n/English/Asset.pm
index 7325b7630..51b7f256b 100644
--- a/lib/WebGUI/i18n/English/Asset.pm
+++ b/lib/WebGUI/i18n/English/Asset.pm
@@ -1409,6 +1409,14 @@ Couldn't open %-s because %-s
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;
diff --git a/sbin/testEnvironment.pl b/sbin/testEnvironment.pl
index 0a692da70..c8b34632d 100755
--- a/sbin/testEnvironment.pl
+++ b/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 );
diff --git a/t/Asset/AssetMetaData.t b/t/Asset/AssetMetaData.t
index 95c891265..b1c4f951f 100644
--- a/t/Asset/AssetMetaData.t
+++ b/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;
diff --git a/t/Asset/Shortcut/030-basic-criteria.t b/t/Asset/Shortcut/030-basic-criteria.t
new file mode 100644
index 000000000..ba0b840c6
--- /dev/null
+++ b/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 <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;
diff --git a/t/lib/WebGUI/Test/Metadata.pm b/t/lib/WebGUI/Test/Metadata.pm
new file mode 100644
index 000000000..09ac545ca
--- /dev/null
+++ b/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;