like( $e->message, qr/Cannot directly delete non-Tradition object/,
"Exception has correct message" );
}
+
$f->delete( $uuid );
ok( !$f->exists( $uuid ), "Object is deleted from DB" );
ok( !$f->exists( $sid ), "Object stemma also deleted from DB" );
my $g = Text::Tradition::Directory->new( 'dsn' => $dsn );
my $scope = $g->new_scope;
is( scalar $g->traditionlist, 1, "Now one object in new directory index" );
+ my $ntobj = $g->tradition( 'CX' );
+ my @w1 = sort { $a->sigil cmp $b->sigil } $ntobj->witnesses;
+ my @w2 = sort{ $a->sigil cmp $b->sigil } $nt->witnesses;
+ is_deeply( \@w1, \@w2, "Looked up remaining tradition by name" );
}
=end testing
=cut
+use Text::Tradition::TypeMap::Entry;
has +typemap => (
- is => 'rw',
- isa => 'KiokuDB::TypeMap',
- default => sub {
- KiokuDB::TypeMap->new(
- isa_entries => {
- "Graph" => KiokuDB::TypeMap::Entry::Naive->new,
- "Graph::AdjacencyMap" => KiokuDB::TypeMap::Entry::Naive->new,
- }
- );
- },
+ is => 'rw',
+ isa => 'KiokuDB::TypeMap',
+ default => sub {
+ KiokuDB::TypeMap->new(
+ isa_entries => {
+ "Text::Tradition" =>
+ KiokuDB::TypeMap::Entry::Naive->new(),
+ "Graph" => Text::Tradition::TypeMap::Entry->new(),
+ "Graph::AdjacencyMap" => Text::Tradition::TypeMap::Entry->new(),
+ "Lingua::Features::Structure" => Text::Tradition::TypeMap::Entry->new,
+ "Lingua::Features::FeatureType" => Text::Tradition::TypeMap::Entry->new,
+ }
+ );
+ },
);
# Push some columns into the extra_args
return $class->$orig( $args );
};
-before [ qw/ store update insert delete / ] => sub {
+# before [ qw/ store update insert delete / ] => sub {
+before [ qw/ delete / ] => sub {
my $self = shift;
my @nontrad;
foreach my $obj ( @_ ) {
sub tradition {
my( $self, $id ) = @_;
my $obj = $self->lookup( $id );
- unless( ref( $obj ) eq 'Text::Tradition' ) {
+ unless( $obj ) {
+ # Try looking up by name.
+ foreach my $item ( $self->traditionlist ) {
+ if( $item->{'name'} eq $id ) {
+ $obj = $self->lookup( $item->{'id'} );
+ last;
+ }
+ }
+ }
+ if( $obj && ref( $obj ) ne 'Text::Tradition' ) {
throw( "Retrieved object is a " . ref( $obj ) . ", not a Text::Tradition" );
}
return $obj;