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 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$/;
  39                 print STDERR "Looking at $_\n";
  40                 my $tradition = Text::Tradition->new(
  41                         'input' => 'Self',
  42                         'file' => "$dir/$_",
  43                         'linear' => 1,
  44                         );
  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                 }
  54
  55                 my $scope = $kdb->new_scope;
  56                 my $tid = $kdb->store( $tradition );
  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;
  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 }