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 Getopt::Long;
   8 use Text::Tradition;
   9 use Text::Tradition::Directory;
  10
  11 binmode( STDOUT, ':utf8' );
  12 binmode( STDERR, ':utf8' );
  13
  14 my( $tfile, $format, $sfile, $delete, $list, $dsn ) =
  15         ( undef, 'Self', undef, undef, 0, 'dbi:SQLite:dbname=db/traditions.db' );
  16
  17 GetOptions(
  18         't|tradition=s' => \$tfile,
  19         'f|format=s' => \$format,
  20         's|stemma=s' => \$sfile,
  21         'l|list' => \$list,
  22         'd|delete=s' => \$delete,
  23         'dsn=s' => \$dsn,
  24         );
  25
  26 # Make a KiokuDB store from the traditions data we have.
  27
  28 my $kdb = Text::Tradition::Directory->new(
  29         'dsn' => $dsn,
  30         'extra_args' => { 'create' => 1 },
  31     );
  32
  33 unless( $tfile || $delete || $list ) {
  34         print STDERR "Please specify a tradition file, an ID to delete, or the --list option\n";
  35         exit;
  36 }
  37
  38 if( $tfile && $delete ) {
  39         print STDERR "Specify deletion by UUID, not by tradition file\n";
  40         exit;
  41 }
  42
  43 my( $tradition, $stemma );
  44 if( $tfile ) {
  45         print STDERR "Reading tradition from $tfile\n";
  46         $tradition = Text::Tradition->new(
  47                 'input' => $format,
  48                 'file' => $tfile,
  49                 'linear' => 1,
  50                 );
  51         if( $tradition && $sfile ) {
  52                 $stemma = $tradition->add_stemma( dotfile =>  $sfile );
  53                 warn "Did not get stemma from $sfile\n" unless $stemma;
  54         }
  55
  56         my $scope = $kdb->new_scope();
  57         my $tid = $kdb->save( $tradition );
  58         print STDERR "Stored tradition for " . $tradition->name . " at $tid\n";
  59         print STDERR "...and associated stemma from $sfile\n" if $stemma;
  60 }
  61
  62 if( $delete ) {
  63         my $scope = $kdb->new_scope();
  64         if( $kdb->exists( $delete ) ) {
  65                 $kdb->delete( $delete );
  66         } else {
  67                 print STDERR "Object $delete does not appear to be a Text::Tradition in the DB\n";
  68         }
  69 }
  70
  71 # Now try reading the objects from the DB.
  72 if( $list ) {
  73         foreach my $tid ( $kdb->tradition_ids ) {
  74                 my $scope = $kdb->new_scope();
  75                 my $t = $kdb->tradition( $tid );
  76                 print STDERR "$tid: Tradition '" . $t->name . "'\n";
  77                 my @wits = map { $_->sigil } $t->witnesses;
  78                 print STDERR "...with witnesses @wits\n";
  79                 my $c = $t->collation;
  80                 print STDERR "...collation has " . scalar( $c->readings ) . " readings\n";
  81                 print STDERR "...collation has " . scalar( $c->paths ) . " paths\n";
  82                 print STDERR "...collation has " . scalar( $c->relationships ) . " relationship links\n";
  83                 foreach my $s ( $t->stemmata ) {
  84                         print STDERR "...associated stemma has graph " . $s->graph . "\n";
  85                 }
  86         }
  87 }