get rid of HACK, allow lacunae, parse other apparatus-ese
[scpubgit/stemmatology.git] / script / save_to_db.pl
1 #!/usr/bin/env perl
2
3 use lib 'lib';
4 use strict;
5 use warnings;
6 use File::Basename;
7 use Text::Tradition;
8 use Text::Tradition::Directory;
9 use Text::Tradition::Stemma;
10
11 binmode( STDOUT, ':utf8' );
12 binmode( STDERR, ':utf8' );
13
14 # Make a KiokuDB store from the traditions data we have.
15
16 my $kdb = Text::Tradition::Directory->new(
17         'dsn' => "dbi:SQLite:dbname=db/traditions.db",
18         'extra_args' => { 'create' => 1 },
19     );
20     
21 my %stemma_map = (
22         'florilegium.xml' => 'stemma_a.dot',
23         'besoin.xml' => 'stemma_b.dot',
24         'heinrichi.xml' => 'stemma_h.dot',
25         'parzival.xml' => 'stemma_p.dot',
26         's158.xml' => 'stemma_s.dot',
27         );
28
29 my $dir = $ARGV[0];
30 if( $dir ) {
31         $dir =~ s/\/$//;
32         opendir( DIR, $dir ) or die "Could not open directory $dir";
33         while( readdir DIR ) {
34                 next unless /\.xml$/;
35                 print STDERR "Looking at $_\n";
36                 my $tradition = Text::Tradition->new( 
37                         'input' => 'Self',
38                         'file' => "$dir/$_",
39                         'linear' => 1,
40                         );
41                 my $stemma;
42                 if( exists $stemma_map{$_} ) {
43                         my $stemmafile = "$dir/" . $stemma_map{$_};     
44                         $stemma = $tradition->add_stemma( $stemmafile );
45                 }
46                 my $scope = $kdb->new_scope();
47                 my $tid = $kdb->save( $tradition );
48                 print STDERR "Stored tradition for " . $tradition->name . " at $tid\n";
49         }
50 }
51
52 # Now try reading the objects from the DB.
53 foreach my $tid ( $kdb->tradition_ids ) {
54         my $scope = $kdb->new_scope();
55         my $t = $kdb->tradition( $tid );
56         print STDERR "Got tradition " . $t->name . " out of the database\n";
57         my @wits = map { $_->sigil } $t->witnesses;
58         print STDERR "...with witnesses @wits\n";
59         my $c = $t->collation;
60         print STDERR "Collation has " . scalar( $c->readings ) . " readings\n";
61         print STDERR "Collation has " . scalar( $c->paths ) . " paths\n";
62         print STDERR "Collation has " . scalar( $c->relationships ) . " relationship links\n";
63         my $s = $t->stemma;
64         if( $s ) {
65                 print STDERR "Got stemma for tradition " . $s->collation->tradition->name 
66                         . " out of the database\n";
67                 print STDERR "Stemma graph is " . $s->graph . "\n";
68         }
69 }