use strict;
use warnings;
use File::Basename;
-use KiokuDB;
-use KiokuDB::TypeMap::Entry::Naive;
+use Getopt::Long;
use Text::Tradition;
-use Text::Tradition::Stemma;
+use Text::Tradition::Directory;
+
+binmode( STDOUT, ':utf8' );
+binmode( STDERR, ':utf8' );
+
+my( $tfile, $format, $sfile, $delete, $list, $dsn ) =
+ ( undef, 'Self', undef, undef, 0, 'dbi:SQLite:dbname=db/traditions.db' );
+
+GetOptions(
+ 't|tradition=s' => \$tfile,
+ 'f|format=s' => \$format,
+ 's|stemma=s' => \$sfile,
+ 'l|list' => \$list,
+ 'd|delete=s' => \$delete,
+ 'dsn=s' => \$dsn,
+ );
# 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" => KiokuDB::TypeMap::Entry::Naive->new,
- "Graph::AdjacencyMap" => KiokuDB::TypeMap::Entry::Naive->new,
- },
- ),
+my $kdb = Text::Tradition::Directory->new(
+ 'dsn' => $dsn,
+ 'extra_args' => { 'create' => 1 },
);
-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',
- );
+unless( $tfile || $delete || $list ) {
+ print STDERR "Please specify a tradition file, an ID to delete, or the --list option\n";
+ exit;
+}
-my $dir = $ARGV[0];
-if( $dir ) {
- $dir =~ s/\/$//;
- opendir( DIR, $dir ) or die "Could not open directory $dir";
- while( readdir DIR ) {
- next unless /\.xml$/;
- print STDERR "Looking at $_\n";
- my $tradition = Text::Tradition->new(
- 'input' => 'Self',
- 'file' => "$dir/$_",
- 'linear' => 1,
- );
- my $stemma;
- if( exists $stemma_map{$_} ) {
- my $stemmafile = "$dir/" . $stemma_map{$_};
- open my $stemma_fh, '<', $stemmafile or die "Could not read stemma file $stemmafile";
- $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 ) if $stemma;
- print STDERR "Stored tradition for " . $tradition->name . " at $tid\n";
- print STDERR "\tand stemma at $sid\n" if $stemma;
- }
+if( $tfile && $delete ) {
+ print STDERR "Specify deletion by UUID, not by tradition file\n";
+ exit;
}
-# Now try reading the objects from the DB.
+my( $tradition, $stemma );
+if( $tfile ) {
+ print STDERR "Reading tradition from $tfile\n";
+ $tradition = Text::Tradition->new(
+ 'input' => $format,
+ 'file' => $tfile,
+ 'linear' => 1,
+ );
+ if( $tradition && $sfile ) {
+ $stemma = $tradition->add_stemma( dotfile => $sfile );
+ warn "Did not get stemma from $sfile\n" unless $stemma;
+ }
+
+ my $scope = $kdb->new_scope();
+ my $tid = $kdb->save( $tradition );
+ print STDERR "Stored tradition for " . $tradition->name . " at $tid\n";
+ print STDERR "...and associated stemma from $sfile\n" if $stemma;
+}
-my $scope = $kdb->new_scope;
+if( $delete ) {
+ my $scope = $kdb->new_scope();
+ if( $kdb->exists( $delete ) ) {
+ $kdb->delete( $delete );
+ } else {
+ print STDERR "Object $delete does not appear to be a Text::Tradition in the DB\n";
+ }
+}
-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";
+# Now try reading the objects from the DB.
+if( $list ) {
+ foreach my $tref ( $kdb->traditionlist ) {
+ my $tid = $tref->{'id'};
+ my $scope = $kdb->new_scope();
+ my $t = $kdb->tradition( $tid );
+ print STDERR "$tid: Tradition '" . $t->name . "'\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";
+ foreach my $s ( $t->stemmata ) {
+ print STDERR "...associated stemma has graph " . $s->graph . "\n";
}
}
}
\ No newline at end of file
projects / scpubgit/stemmatology.git / blobdiff