clean up script dir a little

[scpubgit/stemmatology.git] / script / dblookup.pl

#!/usr/bin/env perl

use lib 'lib';
use strict;
use warnings;
use File::Basename;
use Getopt::Long;
use Text::Tradition;
use Text::Tradition::Directory;

binmode( STDOUT, ':utf8' );
binmode( STDERR, ':utf8' );

my( $name, $delete, $list, $dsn ) = 
	( undef, undef, 1, 'dbi:SQLite:dbname=db/traditions.db' );

GetOptions( 
	'r|rename=s' => \$name,
	'd|delete' => \$delete,
	'dsn=s' => \$dsn,
	);
	
my @uuids = @ARGV;  # UUID is whatever is left over
my $kdb = Text::Tradition::Directory->new( 'dsn' => $dsn );
$list = !$delete;

if( $delete ) {
	print STDERR "Must specify the UUID of a tradition to delete\n" unless @uuids;
	my $scope = $kdb->new_scope();
	foreach my $uuid ( @uuids ) {
		if( $kdb->exists( $uuid ) ) {
			$kdb->delete( $uuid );
		} else {
			print STDERR "No object found with ID $uuid\n";
		}
	}
}

if( $name ) {
	print STDERR "Must specify the UUID of a tradition to rename\n" unless @uuids;
	if( @uuids > 1 ) {
		print STDERR "Multiple traditions given for rename - do you really want to do that?\n";
	} else {
		my $scope = $kdb->new_scope();
		my $tradition = $kdb->lookup( $uuids[0] );
		if( $tradition ) {
			$tradition->name( $name );
			$kdb->save( $tradition );
		} else {
			print STDERR "Unable to find tradition @uuids to rename\n";
		}
	}
}

# Now list the DB contents if appropriate.
if( $list ) {
	my $scope = $kdb->new_scope();
	foreach my $tref ( $kdb->traditionlist ) {
		my $tid = $tref->{'id'};
		# If no IDs were given on the command line, list all traditions.
		if( @uuids ) {
			next unless grep { $_ eq $tid } @uuids;
		}
		my $t = $kdb->lookup( $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";
		}
	}
}