Commit | Line | Data |
041d760c |
1 | #!/usr/bin/env perl |
2 | |
3 | use lib 'lib'; |
4 | use strict; |
5 | use warnings; |
6 | use File::Basename; |
7 | use Getopt::Long; |
8 | use Text::Tradition; |
9 | use Text::Tradition::Directory; |
10 | |
11 | binmode( STDOUT, ':utf8' ); |
12 | binmode( STDERR, ':utf8' ); |
13 | |
a7f70834 |
14 | my( $name, $delete, $dbuser, $dbpass ); |
9b30fc7a |
15 | my( $list, $dsn ) = ( 1, 'dbi:SQLite:dbname=stemmaweb/db/traditions.db' ); |
041d760c |
16 | |
17 | GetOptions( |
18 | 'r|rename=s' => \$name, |
19 | 'd|delete' => \$delete, |
20 | 'dsn=s' => \$dsn, |
a7f70834 |
21 | 'u|user=s' => \$dbuser, |
22 | 'p|pass=s' => \$dbpass, |
041d760c |
23 | ); |
24 | |
25 | my @uuids = @ARGV; # UUID is whatever is left over |
a7f70834 |
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 ); |
041d760c |
30 | $list = !$delete; |
31 | |
32 | if( $delete ) { |
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 ); |
38 | } else { |
39 | print STDERR "No object found with ID $uuid\n"; |
40 | } |
41 | } |
42 | } |
43 | |
44 | if( $name ) { |
45 | print STDERR "Must specify the UUID of a tradition to rename\n" unless @uuids; |
46 | if( @uuids > 1 ) { |
47 | print STDERR "Multiple traditions given for rename - do you really want to do that?\n"; |
48 | } else { |
49 | my $scope = $kdb->new_scope(); |
50 | my $tradition = $kdb->lookup( $uuids[0] ); |
51 | if( $tradition ) { |
52 | $tradition->name( $name ); |
53 | $kdb->save( $tradition ); |
54 | } else { |
55 | print STDERR "Unable to find tradition @uuids to rename\n"; |
56 | } |
57 | } |
58 | } |
59 | |
60 | # Now list the DB contents if appropriate. |
61 | if( $list ) { |
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. |
66 | if( @uuids ) { |
67 | next unless grep { $_ eq $tid } @uuids; |
68 | } |
69 | my $t = $kdb->lookup( $tid ); |
75ce4f7a |
70 | my $tstr = $t->public ? 'Public tradition' : 'Tradition'; |
71 | print STDERR "$tid: $tstr '" . $t->name . "'\n"; |
041d760c |
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"; |
80 | } |
81 | } |
82 | } |