Commit | Line | Data |
8d9a1cd8 |
1 | #!/usr/bin/env perl |
2 | |
3 | use lib 'lib'; |
4 | use strict; |
5 | use warnings; |
6 | use File::Basename; |
ad1291ee |
7 | use Getopt::Long; |
8d9a1cd8 |
8 | use Text::Tradition; |
12523041 |
9 | use Text::Tradition::Directory; |
8d9a1cd8 |
10 | |
12523041 |
11 | binmode( STDOUT, ':utf8' ); |
12 | binmode( STDERR, ':utf8' ); |
13 | |
683f22b1 |
14 | my( $tfile, $format, $sfile, $delete, $list, $dsn ) = |
15 | ( undef, 'Self', undef, undef, 0, 'dbi:SQLite:dbname=db/traditions.db' ); |
ad1291ee |
16 | |
17 | GetOptions( |
18 | 't|tradition=s' => \$tfile, |
683f22b1 |
19 | 'f|format=s' => \$format, |
ad1291ee |
20 | 's|stemma=s' => \$sfile, |
21 | 'l|list' => \$list, |
22 | 'd|delete=s' => \$delete, |
23 | 'dsn=s' => \$dsn, |
24 | ); |
25 | |
8d9a1cd8 |
26 | # Make a KiokuDB store from the traditions data we have. |
27 | |
12523041 |
28 | my $kdb = Text::Tradition::Directory->new( |
ad1291ee |
29 | 'dsn' => $dsn, |
12523041 |
30 | 'extra_args' => { 'create' => 1 }, |
8d9a1cd8 |
31 | ); |
32 | |
ad1291ee |
33 | unless( $tfile || $delete || $list ) { |
34 | print STDERR "Please specify a tradition file, an ID to delete, or the --list option\n"; |
35 | exit; |
36 | } |
8d9a1cd8 |
37 | |
ad1291ee |
38 | if( $tfile && $delete ) { |
39 | print STDERR "Specify deletion by UUID, not by tradition file\n"; |
40 | exit; |
41 | } |
42 | |
43 | my( $tradition, $stemma ); |
44 | if( $tfile ) { |
45 | print STDERR "Reading tradition from $tfile\n"; |
46 | $tradition = Text::Tradition->new( |
683f22b1 |
47 | 'input' => $format, |
ad1291ee |
48 | 'file' => $tfile, |
49 | 'linear' => 1, |
50 | ); |
51 | if( $tradition && $sfile ) { |
173ecc07 |
52 | $stemma = $tradition->add_stemma( dotfile => $sfile ); |
ad1291ee |
53 | warn "Did not get stemma from $sfile\n" unless $stemma; |
8d9a1cd8 |
54 | } |
ad1291ee |
55 | |
56 | my $scope = $kdb->new_scope(); |
57 | my $tid = $kdb->save( $tradition ); |
58 | print STDERR "Stored tradition for " . $tradition->name . " at $tid\n"; |
59 | print STDERR "...and associated stemma from $sfile\n" if $stemma; |
8d9a1cd8 |
60 | } |
61 | |
ad1291ee |
62 | if( $delete ) { |
114bba57 |
63 | my $scope = $kdb->new_scope(); |
ad1291ee |
64 | if( $kdb->exists( $delete ) ) { |
65 | $kdb->delete( $delete ); |
66 | } else { |
67 | print STDERR "Object $delete does not appear to be a Text::Tradition in the DB\n"; |
8d9a1cd8 |
68 | } |
114bba57 |
69 | } |
ad1291ee |
70 | |
71 | # Now try reading the objects from the DB. |
72 | if( $list ) { |
73 | foreach my $tid ( $kdb->tradition_ids ) { |
74 | my $scope = $kdb->new_scope(); |
75 | my $t = $kdb->tradition( $tid ); |
76 | print STDERR "$tid: Tradition '" . $t->name . "'\n"; |
77 | my @wits = map { $_->sigil } $t->witnesses; |
78 | print STDERR "...with witnesses @wits\n"; |
79 | my $c = $t->collation; |
80 | print STDERR "...collation has " . scalar( $c->readings ) . " readings\n"; |
81 | print STDERR "...collation has " . scalar( $c->paths ) . " paths\n"; |
82 | print STDERR "...collation has " . scalar( $c->relationships ) . " relationship links\n"; |
83 | my $s = $t->stemma; |
84 | if( $s ) { |
85 | print STDERR "...associated stemma has graph " . $s->graph . "\n"; |
86 | } |
87 | } |
88 | } |