Commit | Line | Data |
8d9a1cd8 |
1 | #!/usr/bin/env perl |
2 | |
3 | use lib 'lib'; |
4 | use strict; |
5 | use warnings; |
6 | use File::Basename; |
7 | use KiokuDB; |
8 | use KiokuDB::TypeMap::Entry::Naive; |
9 | use Text::Tradition; |
10 | use Text::Tradition::Stemma; |
11 | |
12 | # Make a KiokuDB store from the traditions data we have. |
13 | |
14 | my $kdb = KiokuDB->connect( "dbi:SQLite:dbname=db/traditions.db", |
15 | create => 1, |
16 | typemap => KiokuDB::TypeMap->new( |
17 | isa_entries => { |
18 | "Graph::Easy::Base" => KiokuDB::TypeMap::Entry::Naive->new, |
19 | "Graph" => KiokuDB::TypeMap::Entry::Naive->new, |
20 | "Graph::AdjacencyMap" => KiokuDB::TypeMap::Entry::Naive->new, |
21 | }, |
22 | ), |
23 | ); |
24 | |
25 | my %stemma_map = ( |
26 | 'florilegium.xml' => 'stemma_a.dot', |
27 | 'besoin.xml' => 'stemma_b.dot', |
28 | 'heinrichi.xml' => 'stemma_h.dot', |
29 | 'parzival.xml' => 'stemma_p.dot', |
30 | 's158.xml' => 'stemma_s.dot', |
31 | ); |
32 | |
33 | my $dir = $ARGV[0]; |
34 | if( $dir ) { |
35 | $dir =~ s/\/$//; |
36 | opendir( DIR, $dir ) or die "Could not open directory $dir"; |
37 | while( readdir DIR ) { |
38 | next unless /\.xml$/; |
1f7aa795 |
39 | print STDERR "Looking at $_\n"; |
8d9a1cd8 |
40 | my $tradition = Text::Tradition->new( |
41 | 'input' => 'Self', |
42 | 'file' => "$dir/$_", |
43 | 'linear' => 1, |
44 | ); |
1f7aa795 |
45 | my $stemma; |
46 | if( exists $stemma_map{$_} ) { |
47 | my $stemmafile = "$dir/" . $stemma_map{$_}; |
48 | open my $stemma_fh, '<', $stemmafile or die "Could not read stemma file $stemmafile"; |
49 | $stemma = Text::Tradition::Stemma->new( |
50 | 'collation' => $tradition->collation, |
51 | 'dot' => $stemma_fh, |
52 | ); |
53 | } |
8d9a1cd8 |
54 | |
55 | my $scope = $kdb->new_scope; |
56 | my $tid = $kdb->store( $tradition ); |
1f7aa795 |
57 | my $sid = $kdb->store( $stemma ) if $stemma; |
58 | print STDERR "Stored tradition for " . $tradition->name . " at $tid\n"; |
59 | print STDERR "\tand stemma at $sid\n" if $stemma; |
8d9a1cd8 |
60 | } |
61 | } |
62 | |
63 | # Now try reading the objects from the DB. |
64 | |
65 | my $scope = $kdb->new_scope; |
66 | |
67 | my $stream = $kdb->root_set; |
68 | until( $stream->is_done ) { |
69 | foreach my $t ( $stream->items ) { |
70 | print STDERR "*** Object " . $kdb->object_to_id( $t ) . " ***\n"; |
71 | if( ref( $t ) eq 'Text::Tradition' ) { |
72 | print STDERR "Got tradition " . $t->name . " out of the database\n"; |
73 | my @wits = map { $_->sigil } $t->witnesses; |
74 | print STDERR "...with witnesses @wits\n"; |
75 | my $c = $t->collation; |
76 | print STDERR "Collation has " . scalar( $c->readings ) . " readings\n"; |
77 | print STDERR "Collation has " . scalar( $c->paths ) . " paths\n"; |
78 | print STDERR "Collation has " . scalar( $c->relationships ) . " relationship links\n"; |
79 | } elsif( ref( $t ) eq 'Text::Tradition::Stemma' ) { |
80 | print STDERR "Got stemma for tradition " . $t->collation->tradition->name |
81 | . " out of the database\n"; |
82 | print STDERR "Stemma graph is " . $t->graph . "\n"; |
83 | } else { |
84 | print STDERR "Got unexpected object of type " . ref( $t ) |
85 | . " out of the database\n"; |
86 | } |
87 | } |
88 | } |