9 use Text::Tradition::Directory;
11 binmode( STDOUT, ':utf8' );
12 binmode( STDERR, ':utf8' );
14 my( $name, $delete, $list, $dsn ) =
15 ( undef, undef, 1, 'dbi:SQLite:dbname=db/traditions.db' );
18 'r|rename=s' => \$name,
19 'd|delete' => \$delete,
23 my @uuids = @ARGV; # UUID is whatever is left over
24 my $kdb = Text::Tradition::Directory->new( 'dsn' => $dsn );
28 print STDERR "Must specify the UUID of a tradition to delete\n" unless @uuids;
29 my $scope = $kdb->new_scope();
30 foreach my $uuid ( @uuids ) {
31 if( $kdb->exists( $uuid ) ) {
32 $kdb->delete( $uuid );
34 print STDERR "No object found with ID $uuid\n";
40 print STDERR "Must specify the UUID of a tradition to rename\n" unless @uuids;
42 print STDERR "Multiple traditions given for rename - do you really want to do that?\n";
44 my $scope = $kdb->new_scope();
45 my $tradition = $kdb->lookup( $uuids[0] );
47 $tradition->name( $name );
48 $kdb->save( $tradition );
50 print STDERR "Unable to find tradition @uuids to rename\n";
55 # Now list the DB contents if appropriate.
57 my $scope = $kdb->new_scope();
58 foreach my $tref ( $kdb->traditionlist ) {
59 my $tid = $tref->{'id'};
60 # If no IDs were given on the command line, list all traditions.
62 next unless grep { $_ eq $tid } @uuids;
64 my $t = $kdb->lookup( $tid );
65 print STDERR "$tid: Tradition '" . $t->name . "'\n";
66 my @wits = map { $_->sigil } $t->witnesses;
67 print STDERR "...with witnesses @wits\n";
68 my $c = $t->collation;
69 print STDERR "...collation has " . scalar( $c->readings ) . " readings\n";
70 print STDERR "...collation has " . scalar( $c->paths ) . " paths\n";
71 print STDERR "...collation has " . scalar( $c->relationships ) . " relationship links\n";
72 foreach my $s ( $t->stemmata ) {
73 print STDERR "...associated stemma has graph " . $s->graph . "\n";