set up proper garbage-collecting deletion of traditions from the directory

diff --git a/Makefile.PL b/Makefile.PL
index 826656c..73cb7ad 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -12,6 +12,7 @@ requires( 'Graph' );
 requires( 'Graph::Reader::Dot' );
 requires( 'IPC::Run' );
 requires( 'KiokuDB::Backend::DBI' );
+requires( 'KiokuDB::GC::Naive' );
 requires( 'KiokuDB::TypeMap' );
 requires( 'KiokuDB::TypeMap::Entry::Naive' );
 requires( 'KiokuX::Model' );

diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm
index f945f34..3204ad7 100644 (file)
--- a/lib/Text/Tradition/Collation.pm
+++ b/lib/Text/Tradition/Collation.pm
@@ -255,7 +255,7 @@ specified in the hashref $definition:
 
 =over 4
 
-=item * type - Can be one of spelling, orthographic, grammatical, meaning, repetition, transposition.  The first three are only valid relationships between readings that occur at the same point in the text.
+=item * type - Can be one of spelling, orthographic, grammatical, meaning, lexical, collated, repetition, transposition.  All but the last two are only valid relationships between readings that occur at the same point in the text.
 
 =item * non_correctable - (Optional) True if the reading would not have been corrected independently.
 

diff --git a/lib/Text/Tradition/Directory.pm b/lib/Text/Tradition/Directory.pm
index 42c39f2..f10fda6 100644 (file)
--- a/lib/Text/Tradition/Directory.pm
+++ b/lib/Text/Tradition/Directory.pm
@@ -3,6 +3,7 @@ package Text::Tradition::Directory;
 use strict;
 use warnings;
 use Moose;
+use KiokuDB::GC::Naive;
 use KiokuDB::TypeMap;
 use KiokuDB::TypeMap::Entry::Naive;
 
@@ -91,6 +92,7 @@ warning_like { $e->tradition( $sid ) } qr/not a Text::Tradition/, "Did not retri
 warning_like { $e->delete( $sid ) } qr/Cannot directly delete non-Tradition object/, "Stemma object not deleted from DB";
 $e->delete( $uuid );
 ok( !$e->exists( $uuid ), "Object is deleted from DB" );
+ok( !$e->exists( $sid ), "Object stemma also deleted from DB" );
 is( scalar $e->tradition_ids, 0, "Object is deleted from index" );
 
 
@@ -144,7 +146,7 @@ sub BUILD {
 around delete => sub {
        my $orig = shift;
        my $self = shift;
-       warn "Only the first object will be deleted" if @_ > 1;
+       warn "Will only delete one tradition at a time" if @_ > 1;
        my $arg = shift;
        my $obj = ref( $arg ) ? $arg : $self->lookup( $arg );
        my $id = ref( $arg ) ? $self->object_to_id( $arg ) : $arg;
@@ -153,6 +155,8 @@ around delete => sub {
                return;
        }
        $self->$orig( $arg );
+       my $gc = KiokuDB::GC::Naive->new( backend => $self->directory->backend );
+       $self->$orig( $gc->garbage->members );
        $self->del_index( $id );
 };
 

diff --git a/script/save_to_db.pl b/script/save_to_db.pl
index 061b1eb..936e6a9 100755 (executable)
--- a/script/save_to_db.pl
+++ b/script/save_to_db.pl
@@ -4,66 +4,84 @@ use lib 'lib';
 use strict;
 use warnings;
 use File::Basename;
+use Getopt::Long;
 use Text::Tradition;
 use Text::Tradition::Directory;
-use Text::Tradition::Stemma;
 
 binmode( STDOUT, ':utf8' );
 binmode( STDERR, ':utf8' );
 
+my( $tfile, $sfile, $delete, $list, $dsn ) = 
+       ( undef, undef, undef, 0, 'dbi:SQLite:dbname=db/traditions.db' );
+
+GetOptions( 
+       't|tradition=s' => \$tfile,
+       's|stemma=s' => \$sfile,
+       'l|list' => \$list,
+       'd|delete=s' => \$delete,
+       'dsn=s' => \$dsn,
+       );
+
 # Make a KiokuDB store from the traditions data we have.
 
 my $kdb = Text::Tradition::Directory->new(
-       'dsn' => "dbi:SQLite:dbname=db/traditions.db",
+       'dsn' => $dsn,
        'extra_args' => { 'create' => 1 },
     );
     
-my %stemma_map = (
-       'florilegium.xml' => 'stemma_a.dot',
-       'besoin.xml' => 'stemma_b.dot',
-       'heinrichi.xml' => 'stemma_h.dot',
-       'parzival.xml' => 'stemma_p.dot',
-       's158.xml' => 'stemma_s.dot',
-       );
+unless( $tfile || $delete || $list ) {
+       print STDERR "Please specify a tradition file, an ID to delete, or the --list option\n";
+       exit;
+}
 
-my $dir = $ARGV[0];
-if( $dir ) {
-       $dir =~ s/\/$//;
-       opendir( DIR, $dir ) or die "Could not open directory $dir";
-       while( readdir DIR ) {
-               next unless /\.xml$/;
-               print STDERR "Looking at $_\n";
-               my $tradition = Text::Tradition->new( 
-                       'input' => 'Self',
-                       'file' => "$dir/$_",
-                       'linear' => 1,
-                       );
-               my $stemma;
-               if( exists $stemma_map{$_} ) {
-                       my $stemmafile = "$dir/" . $stemma_map{$_};     
-                       $stemma = $tradition->add_stemma( $stemmafile );
-               }
-               my $scope = $kdb->new_scope();
-               my $tid = $kdb->save( $tradition );
-               print STDERR "Stored tradition for " . $tradition->name . " at $tid\n";
+if( $tfile && $delete ) {
+       print STDERR "Specify deletion by UUID, not by tradition file\n";
+       exit;
+}
+
+my( $tradition, $stemma );
+if( $tfile ) {
+       print STDERR "Reading tradition from $tfile\n";
+       $tradition = Text::Tradition->new( 
+               'input' => 'Self',
+               'file' => $tfile,
+               'linear' => 1,
+               );
+       if( $tradition && $sfile ) {
+               $stemma = $tradition->add_stemma( $sfile );
+               warn "Did not get stemma from $sfile\n" unless $stemma;
        }
+    
+       my $scope = $kdb->new_scope();
+       my $tid = $kdb->save( $tradition );
+       print STDERR "Stored tradition for " . $tradition->name . " at $tid\n";
+       print STDERR "...and associated stemma from $sfile\n" if $stemma;
 }
 
-# Now try reading the objects from the DB.
-foreach my $tid ( $kdb->tradition_ids ) {
+if( $delete ) {
        my $scope = $kdb->new_scope();
-       my $t = $kdb->tradition( $tid );
-       print STDERR "Got tradition " . $t->name . " out of the database\n";
-       my @wits = map { $_->sigil } $t->witnesses;
-       print STDERR "...with witnesses @wits\n";
-       my $c = $t->collation;
-       print STDERR "Collation has " . scalar( $c->readings ) . " readings\n";
-       print STDERR "Collation has " . scalar( $c->paths ) . " paths\n";
-       print STDERR "Collation has " . scalar( $c->relationships ) . " relationship links\n";
-       my $s = $t->stemma;
-       if( $s ) {
-               print STDERR "Got stemma for tradition " . $s->collation->tradition->name 
-                       . " out of the database\n";
-               print STDERR "Stemma graph is " . $s->graph . "\n";
+       if( $kdb->exists( $delete ) ) {
+               $kdb->delete( $delete );
+       } else {
+               print STDERR "Object $delete does not appear to be a Text::Tradition in the DB\n";
        }
 }
+
+# Now try reading the objects from the DB.
+if( $list ) {
+       foreach my $tid ( $kdb->tradition_ids ) {
+               my $scope = $kdb->new_scope();
+               my $t = $kdb->tradition( $tid );
+               print STDERR "$tid: Tradition '" . $t->name . "'\n";
+               my @wits = map { $_->sigil } $t->witnesses;
+               print STDERR "...with witnesses @wits\n";
+               my $c = $t->collation;
+               print STDERR "...collation has " . scalar( $c->readings ) . " readings\n";
+               print STDERR "...collation has " . scalar( $c->paths ) . " paths\n";
+               print STDERR "...collation has " . scalar( $c->relationships ) . " relationship links\n";
+               my $s = $t->stemma;
+               if( $s ) {
+                       print STDERR "...associated stemma has graph " . $s->graph . "\n";
+               }
+       }
+}
\ No newline at end of file

diff --git a/t/text_tradition_directory.t b/t/text_tradition_directory.t
index efc4f23..c473ced 100644 (file)
--- a/t/text_tradition_directory.t
+++ b/t/text_tradition_directory.t
@@ -47,6 +47,7 @@ warning_like { $e->tradition( $sid ) } qr/not a Text::Tradition/, "Did not retri
 warning_like { $e->delete( $sid ) } qr/Cannot directly delete non-Tradition object/, "Stemma object not deleted from DB";
 $e->delete( $uuid );
 ok( !$e->exists( $uuid ), "Object is deleted from DB" );
+ok( !$e->exists( $sid ), "Object stemma also deleted from DB" );
 is( scalar $e->tradition_ids, 0, "Object is deleted from index" );
 }