allow either file or string to be passed for parsing

[scpubgit/stemmatology.git] / lib / Text / Tradition.pm

diff --git a/lib/Text/Tradition.pm b/lib/Text/Tradition.pm
index d376c86..5fa89b7 100644 (file)
--- a/lib/Text/Tradition.pm
+++ b/lib/Text/Tradition.pm
@@ -1,68 +1,120 @@
 package Text::Tradition;
 
-use Text::Tradition::Witness;
-use Text::Tradition::Collation;
+use Module::Load;
 use Moose;
+use Text::Tradition::Collation;
+use Text::Tradition::Witness;
 
 has 'collation' => (
-                   is => 'ro',
-                   isa => 'Text::Tradition::Collation',
-                   );
+    is => 'ro',
+    isa => 'Text::Tradition::Collation',
+    writer => '_save_collation',
+    );
 
 has 'witnesses' => (
-                   traits => ['Array'],
-                   is => 'rw',
-                   isa => 'ArrayRef[Text::Tradition::Witness]',
-                   handles => {
-                       all_options    => 'elements',
-                       add_option     => 'push',
-                       map_options    => 'map',
-                       option_count   => 'count',
-                       sorted_options => 'sort',
-                   },
-                   );
+    traits => ['Array'],
+    isa => 'ArrayRef[Text::Tradition::Witness]',
+    handles => {
+        witnesses    => 'elements',
+        add_witness  => 'push',
+    },
+    default => sub { [] },
+    );
 
-around BUILDARGS => sub {
+has 'name' => (
+    is => 'rw',
+    isa => 'Str',
+    default => 'Tradition',
+    );
+    
+around 'add_witness' => sub {
     my $orig = shift;
-    my $class = shift;
+    my $self = shift;
+    my $new_wit = Text::Tradition::Witness->new( @_ );
+    $self->$orig( $new_wit );
+    return $new_wit;
+};
+    
 
-    # Now @_ contains the original constructor args.  Make a
-    # collation argument and a witnesses argument.
-    my %init_args = @_;
-    my %member_objects = { 'collation' => undef,
-                          'witnesses' => [] };
+sub BUILD {
+    my( $self, $init_args ) = @_;
 
-    if( exists $init_args{'witnesses'} ) {
-       # We got passed an uncollated list of witnesses.  Make a
-       # witness object for each witness, and then send them to the
-       # collator.
-       my $autosigil = 0;
-       foreach my $wit ( %{$init_args{'witnesses'}} ) {
-           # Each item in the list is either a string or an arrayref.
-           # If it's a string, it is a filename; if it's an arrayref,
-           # it is a tuple of 'sigil, file'.  Handle either case.
-           my $args;
-           if( ref( $wit ) eq 'ARRAY' ) {
-               $args = { 'sigil' => $wit->[0],
-                         'file' => $wit->[1] };
-           } else {
-               $args = { 'sigil' => chr( $autosigil+65 ),
-                         'file' => $wit };
-               $autosigil++;
-           }
-           push( @{$member_objects{'witnesses'}},
-                 Text::Tradition::Witness->new( $args ) );
-           # Now how to collate these?
-       }
+    if( exists $init_args->{'witnesses'} ) {
+        # We got passed an uncollated list of witnesses.  Make a
+        # witness object for each witness, and then send them to the
+        # collator.
+        my $autosigil = 0;
+        foreach my $wit ( %{$init_args->{'witnesses'}} ) {
+            # Each item in the list is either a string or an arrayref.
+            # If it's a string, it is a filename; if it's an arrayref,
+            # it is a tuple of 'sigil, file'.  Handle either case.
+            my $args;
+            if( ref( $wit ) eq 'ARRAY' ) {
+                $args = { 'sigil' => $wit->[0],
+                          'file' => $wit->[1] };
+            } else {
+                $args = { 'sigil' => chr( $autosigil+65 ),
+                          'file' => $wit };
+                $autosigil++;
+            }
+            $self->witnesses->add_witness( $args );
+            # TODO Now how to collate these?
+        }
     } else {
-       $member_objects{'collation'} = 
-           Text::Tradition::Collation->new( %init_args );
-       @{$member_objects{'witnesses'}} = 
-           $member_objects->{'collation'}->create_witnesses();
+        # Else we need to parse some collation data.  Make a Collation object
+        my $collation = Text::Tradition::Collation->new( %$init_args,
+                                                        'tradition' => $self );
+        $self->_save_collation( $collation );
+
+        # Call the appropriate parser on the given data
+        my @format_standalone = qw/ Self CollateX CSV CTE TEI Tabular /;
+        my @format_basetext = qw/ KUL /;
+        my $use_base;
+        my $format = $init_args->{'input'};
+        unless( $format ) {
+            warn "No data given to create a collation; will initialize an empty one";
+        }
+        if( $format && !( grep { $_ eq $format } @format_standalone )
+            && !( grep { $_ eq $format } @format_basetext ) ) {
+            warn "Unrecognized input format $format; not parsing";
+            return;
+        }
+        if( $format && grep { $_ eq $format } @format_basetext ) {
+            $use_base = 1;
+            if( !exists $init_args->{'base'} ) {
+                warn "Cannot make a collation from $format without a base text";
+                return;
+            }
+        }
+
+        # Now do the parsing. 
+        if( $format ) {
+            if( $use_base ) { 
+                $format = 'BaseText';   # Use the BaseText module for parsing,
+                                        # but retain the original input arg.
+            }
+            my $mod = "Text::Tradition::Parser::$format";
+            load( $mod );
+            $mod->can('parse')->( $self, $init_args );
+        }
     }
+}
 
-    return $class->$orig( %member_objects );
-};
+sub witness {
+    my( $self, $sigil ) = @_;
+    my $requested_wit;
+    foreach my $wit ( $self->witnesses ) {
+        if( $wit->sigil eq $sigil ) {
+            $requested_wit = $wit;
+            last;
+        }
+    }
+    # We depend on an undef return value for no such witness.
+    # warn "No such witness $sigil" unless $requested_wit;
+    return $requested_wit;
+}
+
+        
 
 # The user will usually be instantiating a Tradition object, and
 # examining its collation.  The information about the tradition can