Get rid of Graph::Easy; add stemma tests
[scpubgit/stemmatology.git] / script / save_to_db.pl
CommitLineData
8d9a1cd8 1#!/usr/bin/env perl
2
3use lib 'lib';
4use strict;
5use warnings;
6use File::Basename;
8d9a1cd8 7use Text::Tradition;
12523041 8use Text::Tradition::Directory;
8d9a1cd8 9use Text::Tradition::Stemma;
10
12523041 11binmode( STDOUT, ':utf8' );
12binmode( STDERR, ':utf8' );
13
8d9a1cd8 14# Make a KiokuDB store from the traditions data we have.
15
12523041 16my $kdb = Text::Tradition::Directory->new(
17 'dsn' => "dbi:SQLite:dbname=db/traditions.db",
18 'extra_args' => { 'create' => 1 },
8d9a1cd8 19 );
20
21my %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
29my $dir = $ARGV[0];
30if( $dir ) {
31 $dir =~ s/\/$//;
32 opendir( DIR, $dir ) or die "Could not open directory $dir";
33 while( readdir DIR ) {
34 next unless /\.xml$/;
1f7aa795 35 print STDERR "Looking at $_\n";
8d9a1cd8 36 my $tradition = Text::Tradition->new(
37 'input' => 'Self',
38 'file' => "$dir/$_",
39 'linear' => 1,
40 );
1f7aa795 41 my $stemma;
42 if( exists $stemma_map{$_} ) {
43 my $stemmafile = "$dir/" . $stemma_map{$_};
44 open my $stemma_fh, '<', $stemmafile or die "Could not read stemma file $stemmafile";
45 $stemma = Text::Tradition::Stemma->new(
46 'collation' => $tradition->collation,
47 'dot' => $stemma_fh,
48 );
49 }
8d9a1cd8 50
12523041 51 my $tid = $kdb->save_tradition( $tradition );
52 my $sid = $kdb->save_stemma( $stemma ) if $stemma;
1f7aa795 53 print STDERR "Stored tradition for " . $tradition->name . " at $tid\n";
54 print STDERR "\tand stemma at $sid\n" if $stemma;
8d9a1cd8 55 }
56}
57
58# Now try reading the objects from the DB.
59
12523041 60foreach my $tid ( $kdb->tradition_ids ) {
61 my $t = $kdb->tradition( $tid );
62 print STDERR "Got tradition " . $t->name . " out of the database\n";
63 my @wits = map { $_->sigil } $t->witnesses;
64 print STDERR "...with witnesses @wits\n";
65 my $c = $t->collation;
66 print STDERR "Collation has " . scalar( $c->readings ) . " readings\n";
67 print STDERR "Collation has " . scalar( $c->paths ) . " paths\n";
68 print STDERR "Collation has " . scalar( $c->relationships ) . " relationship links\n";
69 my $s = $kdb->stemma( $tid );
70 if( $s ) {
71 print STDERR "Got stemma for tradition " . $s->collation->tradition->name
72 . " out of the database\n";
73 print STDERR "Stemma graph is " . $s->graph . "\n";
8d9a1cd8 74 }
75}