From: Tara L Andrews Date: Wed, 21 Dec 2011 19:41:26 +0000 (+0100) Subject: store tradition objects in a KiokuDB instance X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2Fstemmatology.git;a=commitdiff_plain;h=8d9a1cd8a3ed4cc4efeb193974cb9f53fda40df8 store tradition objects in a KiokuDB instance --- diff --git a/Makefile.PL b/Makefile.PL index 3218b99..b3daa58 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -13,6 +13,9 @@ requires( 'Graph::Convert' ); requires( 'Graph::Easy' ); requires( 'Graph::Reader::Dot' ); requires( 'IPC::Run' ); +requires( 'KiokuDB::TypeMap' ); +requires( 'KiokuDB::TypeMap::Entry::Naive' ); +requires( 'KiokuX::Model' ); requires( 'Module::Load' ); requires( 'Moose' ); requires( 'Moose::Util::TypeConstraints' ); diff --git a/lib/Text/Tradition/Collation.pm b/lib/Text/Tradition/Collation.pm index 7ca8db4..236a9bd 100644 --- a/lib/Text/Tradition/Collation.pm +++ b/lib/Text/Tradition/Collation.pm @@ -34,6 +34,7 @@ has 'graph' => ( has 'tradition' => ( # TODO should this not be ro? is => 'rw', isa => 'Text::Tradition', + weak_ref => 1, ); has 'svg' => ( @@ -57,14 +58,6 @@ has 'csv' => ( predicate => 'has_csv', ); -# Keeps track of the lemmas within the collation. At most one lemma -# per position in the graph. -has 'lemmata' => ( - is => 'ro', - isa => 'HashRef[Maybe[Str]]', - default => sub { {} }, - ); - has 'wit_list_separator' => ( is => 'rw', isa => 'Str', diff --git a/lib/Text/Tradition/Directory.pm b/lib/Text/Tradition/Directory.pm new file mode 100644 index 0000000..451afe3 --- /dev/null +++ b/lib/Text/Tradition/Directory.pm @@ -0,0 +1,97 @@ +package Text::Tradition::Directory; + +use strict; +use warnings; +use Moose; +use KiokuDB::TypeMap; +use KiokuDB::TypeMap::Entry::Naive; + +extends 'KiokuX::Model'; + +has data_hash => ( + traits => ['Hash'], + default => sub { {} }, + handles => { + tradition => 'get', + stemma => 'get', + add_tradition => 'set', + add_stemma => 'set', + traditions => 'keys', + }, +); + +has typemap => ( + is => 'rw', + isa => 'KiokuDB::TypeMap', + default => sub { + KiokuDB::TypeMap->new( + isa_entries => { + "Graph::Easy::Base" => KiokuDB::TypeMap::Entry::Naive->new, + "Graph" => KiokuDB::TypeMap::Entry::Naive->new, + "Graph::AdjacencyMap" => KiokuDB::TypeMap::Entry::Naive->new, + } + ); + }, +); + +around 'tradition' => sub { + my( $orig, $self, @arg ) = @_; + my $data = $self->$orig( @arg ); + return $data->{'object'}; +}; + +around 'stemma' => sub { + my( $orig, $self, @arg ) = @_; + my $data = $self->$orig( @arg ); + return $data->{'stemma'}; +}; + +around 'add_tradition' => sub { + my( $orig, $self, $id, $obj ) = @_; + $self->$orig( $id => { 'object' => $obj } ); +}; + +around 'add_stemma' => sub { + my( $orig, $self, $id, $obj ) = @_; + $self->{data_hash}->{$id}->{'stemma'} = $obj; +}; + +# Load all the relevant data from the DSN we were passed. + +sub BUILD { + my $self = shift; + my $args = shift; + + if( exists $args->{'dsn'} ) { + # Connect to self, get the traditions and stemmas, and save them + # in the directory. + my $scope = $self->new_scope; + my $stream = $self->root_set; + my %stemmata; + until( $stream->is_done ) { + foreach my $obj ( $stream->items ) { + my $uuid = $self->object_to_id( $obj ); + if( ref( $obj ) eq 'Text::Tradition' ) { + $self->add_tradition( $uuid => $obj ); + } elsif( ref( $obj ) eq 'Text::Tradition::Stemma' ) { + $stemmata{$obj->collation} = $obj; + } else { + warn "Found root object in DB that is neither tradition nor stemma: $obj"; + } + } + } + # Now match the stemmata to their traditions. + foreach my $id ( $self->traditions ) { + my $c = $self->tradition( $id )->collation; + if( exists $stemmata{$c} ) { + $self->add_stemma( $id => $stemmata{$c} ); + } + } + } + + return $self; +} + +1; + + \ No newline at end of file diff --git a/lib/Text/Tradition/Stemma.pm b/lib/Text/Tradition/Stemma.pm index 28a9109..c90b536 100644 --- a/lib/Text/Tradition/Stemma.pm +++ b/lib/Text/Tradition/Stemma.pm @@ -15,6 +15,7 @@ has collation => ( is => 'ro', isa => 'Text::Tradition::Collation', required => 1, + weak_ref => 1, ); has graph => ( @@ -34,22 +35,25 @@ sub BUILD { my( $self, $args ) = @_; # If we have been handed a dotfile, initialize it into a graph. if( exists $args->{'dot'} ) { - # Open the file, assume UTF-8 - open( my $dot, $args->{'dot'} ) or warn "Failed to read dot file"; - # TODO don't bother if we haven't opened - binmode $dot, ":utf8"; - my $reader = Graph::Reader::Dot->new(); - my $graph = $reader->read_graph( $dot ); - $graph - ? $self->graph( $graph ) - : warn "Failed to parse dot file " . $args->{'dot'}; + $self->graph_from_dot( $args->{'dot'} ); } } -# Render the stemma as SVG. -sub as_svg { +sub graph_from_dot { + my( $self, $dotfh ) = @_; + # Assume utf-8 + binmode( $dotfh, ':utf8' ); + my $reader = Graph::Reader::Dot->new(); + my $graph = $reader->read_graph( $dotfh ); + $graph + ? $self->graph( $graph ) + : warn "Failed to parse dot in $dotfh"; +} + +sub as_dot { my( $self, $opts ) = @_; # TODO add options for display, someday + # TODO see what happens with Graph::Writer::Dot someday my $dgraph = Graph::Convert->as_graph_easy( $self->graph ); # Set some class display attributes for 'hypothetical' and 'extant' nodes $dgraph->set_attribute( 'flow', 'south' ); @@ -69,13 +73,21 @@ sub as_svg { my $sizeline = " graph [ size=\"" . $opts->{'size'} . "\" ]"; splice( @lines, 1, 0, $sizeline ); } + return join( "\n", @lines ); +} + + +# Render the stemma as SVG. +sub as_svg { + my( $self, $opts ) = @_; + my $dot = $self->as_dot( $opts ); my @cmd = qw/dot -Tsvg/; my( $svg, $err ); my $dotfile = File::Temp->new(); ## TODO REMOVE # $dotfile->unlink_on_destroy(0); binmode $dotfile, ':utf8'; - print $dotfile join( "\n", @lines ); + print $dotfile $dot; push( @cmd, $dotfile->filename ); run( \@cmd, ">", binary(), \$svg ); $svg = decode_utf8( $svg ); diff --git a/script/save_to_db.pl b/script/save_to_db.pl new file mode 100644 index 0000000..45ebb17 --- /dev/null +++ b/script/save_to_db.pl @@ -0,0 +1,85 @@ +#!/usr/bin/env perl + +use lib 'lib'; +use strict; +use warnings; +use File::Basename; +use KiokuDB; +use KiokuDB::TypeMap::Entry::Naive; +use Text::Tradition; +use Text::Tradition::Stemma; + +# Make a KiokuDB store from the traditions data we have. + +my $kdb = KiokuDB->connect( "dbi:SQLite:dbname=db/traditions.db", + create => 1, + typemap => KiokuDB::TypeMap->new( + isa_entries => { + "Graph::Easy::Base" => KiokuDB::TypeMap::Entry::Naive->new, + "Graph" => KiokuDB::TypeMap::Entry::Naive->new, + "Graph::AdjacencyMap" => KiokuDB::TypeMap::Entry::Naive->new, + }, + ), + ); + +my %stemma_map = ( + 'florilegium.xml' => 'stemma_a.dot', + 'besoin.xml' => 'stemma_b.dot', + 'heinrichi.xml' => 'stemma_h.dot', + 'parzival.xml' => 'stemma_p.dot', + 's158.xml' => 'stemma_s.dot', + ); + +my $dir = $ARGV[0]; +if( $dir ) { + $dir =~ s/\/$//; + opendir( DIR, $dir ) or die "Could not open directory $dir"; + while( readdir DIR ) { + next unless /\.xml$/; + my $stemmafile = "$dir/" . $stemma_map{$_}; + my $tradition = Text::Tradition->new( + 'input' => 'Self', + 'file' => "$dir/$_", + 'linear' => 1, + ); + open my $stemma_fh, '<', $stemmafile or die "Could not read stemma file $stemmafile"; + my $stemma = Text::Tradition::Stemma->new( + 'collation' => $tradition->collation, + 'dot' => $stemma_fh, + ); + + my $scope = $kdb->new_scope; + my $tid = $kdb->store( $tradition ); + my $sid = $kdb->store( $stemma ); + + print STDERR "Stored tradition and stemma for " . $tradition->name + . ", got $tid / $sid as the ref\n"; + } +} + +# Now try reading the objects from the DB. + +my $scope = $kdb->new_scope; + +my $stream = $kdb->root_set; +until( $stream->is_done ) { + foreach my $t ( $stream->items ) { + print STDERR "*** Object " . $kdb->object_to_id( $t ) . " ***\n"; + if( ref( $t ) eq 'Text::Tradition' ) { + print STDERR "Got tradition " . $t->name . " out of the database\n"; + my @wits = map { $_->sigil } $t->witnesses; + print STDERR "...with witnesses @wits\n"; + my $c = $t->collation; + print STDERR "Collation has " . scalar( $c->readings ) . " readings\n"; + print STDERR "Collation has " . scalar( $c->paths ) . " paths\n"; + print STDERR "Collation has " . scalar( $c->relationships ) . " relationship links\n"; + } elsif( ref( $t ) eq 'Text::Tradition::Stemma' ) { + print STDERR "Got stemma for tradition " . $t->collation->tradition->name + . " out of the database\n"; + print STDERR "Stemma graph is " . $t->graph . "\n"; + } else { + print STDERR "Got unexpected object of type " . ref( $t ) + . " out of the database\n"; + } + } +} \ No newline at end of file