use Module::Load;
use Moose;
use Moose::Util qw/ does_role apply_all_roles /;
+use Safe::Isa;
use Text::Tradition::Collation;
use Text::Tradition::Error;
use Text::Tradition::Witness;
use TryCatch;
use vars qw( $VERSION );
-$VERSION = "1.1";
+$VERSION = "1.2";
# Enable plugin(s) if available
eval { with 'Text::Tradition::HasStemma'; };
writer => '_init_done',
);
-# Create the witness before trying to add it
+# Create the witness if necessary before trying to add it
around 'add_witness' => sub {
my $orig = shift;
my $self = shift;
- # TODO allow add of a Witness object?
- my %args = @_ == 1 ? %{$_[0]} : @_;
- $args{'tradition'} = $self;
- my $new_wit = Text::Tradition::Witness->new( %args );
+ my $new_wit;
+ if( @_ == 1 && $_[0]->$_isa( 'Text::Tradition::Witness' ) ) {
+ $new_wit = shift;
+ } else {
+ my %args = @_ == 1 ? %{$_[0]} : @_;
+ $args{'tradition'} = $self;
+ $new_wit = Text::Tradition::Witness->new( %args );
+ }
$self->$orig( $new_wit->sigil => $new_wit );
return $new_wit;
};
return $self->$orig( $arg );
};
+# Cope with witness sigil changes
+sub rename_witness {
+ my( $self, $sig, $newsig ) = @_;
+ $DB::single = 1;
+ my $wit = $self->witness( $sig );
+ $self->throw( "No such witness $sig" ) unless $wit;
+ $self->throw( "Cannot rename witness that has already been collated" )
+ if $wit->is_collated;
+ $wit = $self->del_witness( $sig );
+ try {
+ $wit->_set_sigil( $newsig );
+ } catch ( $e ) {
+ # Don't lose the witness if the rename failed
+ $self->add_witness( $wit );
+ $self->throw( $e );
+ }
+ $self->add_witness( $wit );
+}
+
=head1 NAME
Text::Tradition - a software model for a set of collated texts
=begin testing
+use TryCatch;
use_ok( 'Text::Tradition', "can use module" );
my $t = Text::Tradition->new( 'name' => 'empty' );
is( $s->witness('X'), undef, "There is no witness X" );
ok( !exists $s->{'witnesses'}->{'X'}, "Witness key X not created" );
-my $wit_d = $s->add_witness( 'sigil' => 'D', 'sourcetype' => 'collation' );
+my $wit_d = $s->add_witness( 'sigil' => 'D', 'sourcetype' => 'plaintext',
+ 'string' => 'je suis depourvu de foi' );
is( ref( $wit_d ), 'Text::Tradition::Witness', "new witness created" );
is( $wit_d->sigil, 'D', "witness has correct sigil" );
is( scalar $s->witnesses, 4, "object now has four witnesses" );
-my $del = $s->del_witness( 'D' );
+try {
+ $s->rename_witness( 'D', 'Invalid Sigil' );
+ ok( 0, "Renamed witness with bad sigil" );
+} catch ( Text::Tradition::Error $e ) {
+ print STDERR $e->message . "\n";
+ is( $s->witness('D'), $wit_d, "Held onto witness during bad rename" );
+}
+
+try {
+ $s->rename_witness( 'D', 'Q' );
+ ok( 1, "Rename of witness succeeded" );
+ is( $s->witness('Q'), $wit_d, "Witness available under new sigil" );
+ ok( !$s->has_witness('D'), "Witness no longer available under old sigil" );
+} catch ( Text::Tradition::Error $e ) {
+ ok( 0, "Failed to rename witness: " . $e->message );
+}
+
+my $del = $s->del_witness( 'Q' );
is( $del, $wit_d, "Deleted correct witness" );
is( scalar $s->witnesses, 3, "object has three witnesses again" );
-# TODO test initialization by witness list when we have it
+try {
+ $s->rename_witness( 'A', 'WitA' );
+ ok( 0, "Successfully renamed an already collated witness" );
+} catch ( Text::Tradition::Error $e ) {
+ is( $e->message, 'Cannot rename witness that has already been collated',
+ "Refused to rename an already-collated witness" );
+}
=end testing
## Add the path for each witness listesd.
# Create the witness objects if they does not yet exist.
foreach my $wit ( split( /, /, $e->{$WITKEY} ) ) {
- unless( $tradition->witness( $wit ) ) {
+ if( $tradition->witness( $wit ) ) {
+ $tradition->witness( $wit )->is_collated( 1 );
+ } else {
$tradition->add_witness(
'sigil' => $wit, 'sourcetype' => 'collation' );
}
my @witnesses; # Keep the ordered list of our witnesses
my %ac_wits; # Track these for later removal
foreach my $sigil ( map { $_->{'witness'} } @{$table->{'alignment'}} ) {
- my $wit = $tradition->add_witness(
- 'sigil' => $sigil, 'sourcetype' => 'collation' );
+ my $wit;
+ if( $tradition->has_witness( $sigil ) {
+ $wit = $tradition->witness( $sigil );
+ $wit->is_collated( 1 );
+ } else {
+ $wit = $tradition->add_witness(
+ 'sigil' => $sigil, 'sourcetype' => 'collation' );
+ }
$wit->path( [ $c->start ] );
push( @witnesses, $wit );
my $aclabel = $c->ac_label;
predicate => 'has_layertext',
);
+has 'is_collated' => (
+ is => 'rw',
+ isa => 'Bool'
+ );
+
# Path. This is an array of Reading nodes that can be saved during
# initialization, but should be cleared before saving in a DB.
has 'path' => (
$self->$init_sub();
# Remove our XML / source objects; we no longer need them.
$self->clear_object if $self->has_object;
- $self->tradition->collation->make_witness_path( $self );
+ # $self->tradition->collation->make_witness_path( $self );
+ }
+ if( $self->sourcetype eq 'collation' ) {
+ $self->is_collated( 1 );
}
return $self;
}
# =begin testing
{
+use TryCatch;
use_ok( 'Text::Tradition', "can use module" );
my $t = Text::Tradition->new( 'name' => 'empty' );
is( $s->witness('X'), undef, "There is no witness X" );
ok( !exists $s->{'witnesses'}->{'X'}, "Witness key X not created" );
-my $wit_d = $s->add_witness( 'sigil' => 'D', 'sourcetype' => 'collation' );
+my $wit_d = $s->add_witness( 'sigil' => 'D', 'sourcetype' => 'plaintext',
+ 'string' => 'je suis depourvu de foi' );
is( ref( $wit_d ), 'Text::Tradition::Witness', "new witness created" );
is( $wit_d->sigil, 'D', "witness has correct sigil" );
is( scalar $s->witnesses, 4, "object now has four witnesses" );
-my $del = $s->del_witness( 'D' );
+try {
+ $s->rename_witness( 'D', 'Invalid Sigil' );
+ ok( 0, "Renamed witness with bad sigil" );
+} catch ( Text::Tradition::Error $e ) {
+ print STDERR $e->message . "\n";
+ is( $s->witness('D'), $wit_d, "Held onto witness during bad rename" );
+}
+
+try {
+ $s->rename_witness( 'D', 'Q' );
+ ok( 1, "Rename of witness succeeded" );
+ is( $s->witness('Q'), $wit_d, "Witness available under new sigil" );
+ ok( !$s->has_witness('D'), "Witness no longer available under old sigil" );
+} catch ( Text::Tradition::Error $e ) {
+ ok( 0, "Failed to rename witness: " . $e->message );
+}
+
+my $del = $s->del_witness( 'Q' );
is( $del, $wit_d, "Deleted correct witness" );
is( scalar $s->witnesses, 3, "object has three witnesses again" );
-# TODO test initialization by witness list when we have it
+try {
+ $s->rename_witness( 'A', 'WitA' );
+ ok( 0, "Successfully renamed an already collated witness" );
+} catch ( Text::Tradition::Error $e ) {
+ is( $e->message, 'Cannot rename witness that has already been collated',
+ "Refused to rename an already-collated witness" );
+}
}
requires( 'Module::Load' );
requires( 'Moose' );
requires( 'Moose::Role' );
-requires( 'Text::Tradition' => '1.1' );
+requires( 'Text::Tradition' => '1.2' );
requires( 'TryCatch' );
build_requires( 'Safe::Isa' );
build_requires( 'Test::Warn' );
projects / scpubgit/stemmatology.git / commitdiff