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' );
has 'tradition' => ( # TODO should this not be ro?
is => 'rw',
isa => 'Text::Tradition',
+ weak_ref => 1,
);
has 'svg' => (
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',
--- /dev/null
+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
is => 'ro',
isa => 'Text::Tradition::Collation',
required => 1,
+ weak_ref => 1,
);
has graph => (
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' );
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 );
--- /dev/null
+#!/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
projects / scpubgit/stemmatology.git / commitdiff