9 use Text::Tradition::Directory;
11 binmode( STDOUT, ':utf8' );
12 binmode( STDERR, ':utf8' );
14 my( $name, $delete, $dbuser, $dbpass );
15 my( $list, $dsn ) = ( 1, 'dbi:SQLite:dbname=stemmaweb/db/traditions.db' );
18 'r|rename=s' => \$name,
19 'd|delete' => \$delete,
21 'u|user=s' => \$dbuser,
22 'p|pass=s' => \$dbpass,
25 my @uuids = @ARGV; # UUID is whatever is left over
26 my %dbargs = ( 'dsn' => $dsn );
27 $dbargs{'extra_args'} = { 'user' => $dbuser } if $dbuser;
28 $dbargs{'extra_args'}->{'password'} = $dbpass if $dbpass;
29 my $kdb = Text::Tradition::Directory->new( %dbargs );
33 print STDERR "Must specify the UUID of a tradition to delete\n" unless @uuids;
34 my $scope = $kdb->new_scope();
35 foreach my $uuid ( @uuids ) {
36 if( $kdb->exists( $uuid ) ) {
37 $kdb->delete( $uuid );
39 print STDERR "No object found with ID $uuid\n";
45 print STDERR "Must specify the UUID of a tradition to rename\n" unless @uuids;
47 print STDERR "Multiple traditions given for rename - do you really want to do that?\n";
49 my $scope = $kdb->new_scope();
50 my $tradition = $kdb->lookup( $uuids[0] );
52 $tradition->name( $name );
53 $kdb->save( $tradition );
55 print STDERR "Unable to find tradition @uuids to rename\n";
60 # Now list the DB contents if appropriate.
62 my $scope = $kdb->new_scope();
63 foreach my $tref ( $kdb->traditionlist ) {
64 my $tid = $tref->{'id'};
65 # If no IDs were given on the command line, list all traditions.
67 next unless grep { $_ eq $tid } @uuids;
69 my $t = $kdb->lookup( $tid );
70 my $tstr = $t->public ? 'Public tradition' : 'Tradition';
71 print STDERR "$tid: $tstr '" . $t->name . "'\n";
72 my @wits = map { $_->sigil } $t->witnesses;
73 print STDERR "...with witnesses @wits\n";
74 my $c = $t->collation;
75 print STDERR "...collation has " . scalar( $c->readings ) . " readings\n";
76 print STDERR "...collation has " . scalar( $c->paths ) . " paths\n";
77 print STDERR "...collation has " . scalar( $c->relationships ) . " relationship links\n";
78 foreach my $s ( $t->stemmata ) {
79 print STDERR "...associated stemma has graph " . $s->graph . "\n";