From: Tara L Andrews Date: Sat, 28 Apr 2012 11:00:10 +0000 (+0200) Subject: repurpose outdated DB-save script as a DB-query script X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=041d760cbcf2aca8b26586ef3bf6af7a846f94e2;p=scpubgit%2Fstemmatology.git repurpose outdated DB-save script as a DB-query script --- diff --git a/script/dblookup.pl b/script/dblookup.pl new file mode 100755 index 0000000..a7a6c4d --- /dev/null +++ b/script/dblookup.pl @@ -0,0 +1,76 @@ +#!/usr/bin/env perl + +use lib 'lib'; +use strict; +use warnings; +use File::Basename; +use Getopt::Long; +use Text::Tradition; +use Text::Tradition::Directory; + +binmode( STDOUT, ':utf8' ); +binmode( STDERR, ':utf8' ); + +my( $name, $delete, $list, $dsn ) = + ( undef, undef, 1, 'dbi:SQLite:dbname=db/traditions.db' ); + +GetOptions( + 'r|rename=s' => \$name, + 'd|delete' => \$delete, + 'dsn=s' => \$dsn, + ); + +my @uuids = @ARGV; # UUID is whatever is left over +my $kdb = Text::Tradition::Directory->new( 'dsn' => $dsn ); +$list = !$delete; + +if( $delete ) { + print STDERR "Must specify the UUID of a tradition to delete\n" unless @uuids; + my $scope = $kdb->new_scope(); + foreach my $uuid ( @uuids ) { + if( $kdb->exists( $uuid ) ) { + $kdb->delete( $uuid ); + } else { + print STDERR "No object found with ID $uuid\n"; + } + } +} + +if( $name ) { + print STDERR "Must specify the UUID of a tradition to rename\n" unless @uuids; + if( @uuids > 1 ) { + print STDERR "Multiple traditions given for rename - do you really want to do that?\n"; + } else { + my $scope = $kdb->new_scope(); + my $tradition = $kdb->lookup( $uuids[0] ); + if( $tradition ) { + $tradition->name( $name ); + $kdb->save( $tradition ); + } else { + print STDERR "Unable to find tradition @uuids to rename\n"; + } + } +} + +# Now list the DB contents if appropriate. +if( $list ) { + my $scope = $kdb->new_scope(); + foreach my $tref ( $kdb->traditionlist ) { + my $tid = $tref->{'id'}; + # If no IDs were given on the command line, list all traditions. + if( @uuids ) { + next unless grep { $_ eq $tid } @uuids; + } + my $t = $kdb->lookup( $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"; + foreach my $s ( $t->stemmata ) { + print STDERR "...associated stemma has graph " . $s->graph . "\n"; + } + } +} diff --git a/script/save_to_db.pl b/script/save_to_db.pl deleted file mode 100755 index 2d734b3..0000000 --- a/script/save_to_db.pl +++ /dev/null @@ -1,88 +0,0 @@ -#!/usr/bin/env perl - -use lib 'lib'; -use strict; -use warnings; -use File::Basename; -use Getopt::Long; -use Text::Tradition; -use Text::Tradition::Directory; - -binmode( STDOUT, ':utf8' ); -binmode( STDERR, ':utf8' ); - -my( $tfile, $format, $sfile, $delete, $list, $dsn ) = - ( undef, 'Self', undef, undef, 0, 'dbi:SQLite:dbname=db/traditions.db' ); - -GetOptions( - 't|tradition=s' => \$tfile, - 'f|format=s' => \$format, - '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' => $dsn, - 'extra_args' => { 'create' => 1 }, - ); - -unless( $tfile || $delete || $list ) { - print STDERR "Please specify a tradition file, an ID to delete, or the --list option\n"; - exit; -} - -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' => $format, - 'file' => $tfile, - 'linear' => 1, - ); - if( $tradition && $sfile ) { - $stemma = $tradition->add_stemma( dotfile => $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; -} - -if( $delete ) { - my $scope = $kdb->new_scope(); - 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 $tref ( $kdb->traditionlist ) { - my $tid = $tref->{'id'}; - 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"; - foreach my $s ( $t->stemmata ) { - print STDERR "...associated stemma has graph " . $s->graph . "\n"; - } - } -} \ No newline at end of file