1 package Text::Tradition::Parser::KUL;
5 use Storable qw /dclone/;
6 use Text::CSV::Simple; # TODO convert to CSV_XS
10 Text::Tradition::Parser::KUL
14 Parser module for Text::Tradition, given a list of variants as a CSV
15 file and a reference text as a plaintext file with appropriate line
16 breaks. The CSV file is a specialized format developed at KU Leuven,
17 and other formats are vastly preferred.
23 my @apparatus = read( $csv_file );
25 Takes a CSV file; returns a data structure of apparatus entries to be
26 merged with a base text.
32 my $parser = Text::CSV::Simple->new();
33 my @fields = qw/ reference text variant type context non_corr non_indep
34 length total origin /;
35 my @lines = $parser->read_file( $opts->{'file'} );
36 my @labels = @{shift( @lines )};
37 push( @fields, @labels[10..$#labels] );
43 foreach my $line ( @lines ) {
45 if( $line->[0] =~ /^\d/ ) {
46 $new_lemma = $started = 1;
50 # Get the lines into their fields.
52 @linehash{@fields} = @$line;
54 # Readings can take up multiple lines in the CSV, so append the
55 # apparatus to the list, and clear it out, if we have started a
58 # Was it a doubled-up apparatus entry e.g 'non (1/2)'?
59 if( keys %$apparatus &&
60 $apparatus->{'rdg_0'} =~ /(.*?)\s+\(?([\d\/]+)\)?\s*$/ ) {
61 my( $reading, $istr ) = ( $1, $2 );
62 my @instances = split( /\//, $istr );
63 foreach my $i ( @instances ) {
64 my $app = dclone( $apparatus );
65 $app->{'rdg_0'} = $reading . "_$i";
66 $app->{'_id'} .= chr(97+$i);
67 push( @app_list, $app );
69 } elsif( keys %$apparatus ) {
70 push( @app_list, $apparatus );
72 $apparatus = { _id => $linehash{reference} };
75 # The apparatus has multiple readings, and multiple witnesses per
76 # reading. So it's a hashref whose values are listrefs.
77 $apparatus->{'rdg_0'} = $linehash{'text'} if $linehash{'text'};
78 $apparatus->{'rdg_' . ++$rdg_ctr} = $linehash{'variant'};
79 foreach my $attr ( @fields[3..8] ) {
80 $apparatus->{"_rdg_${rdg_ctr}_$attr"} = $linehash{$attr} if defined $linehash{$attr};
83 foreach my $k ( @fields[10..$#fields] ) {
84 my $variant_rdg = $linehash{$k};
85 $k =~ s/\s+\(a\.c\.\)//;
86 if( $variant_rdg =~ /^0/ ) {
87 $apparatus->{$k} = 'rdg_0'
88 unless exists $apparatus->{$k};
89 } elsif ( $variant_rdg =~ /^1/ ) {
90 warn sprintf( "Already found variant reading %s for %s at %s!",
91 $apparatus->{$k}, $k, $apparatus->{_id} )
92 if exists $apparatus->{$k} && $apparatus->{$k} ne 'rdg_0';
93 $apparatus->{$k} = 'rdg_' . $rdg_ctr;
94 } else { # else for $, we don't list the MS
95 warn "Unparsed variant indicator $variant_rdg for $k in " .
97 unless ( !$variant_rdg or $variant_rdg =~ /^\$$/ );
100 # See if we have at least one reading for each variant.
101 my @seen_rdgs = values %$apparatus;
102 foreach my $rdg ( grep { $_ =~ /^rdg/ } keys %$apparatus ) {
103 unless( grep { $_ =~ /^$rdg$/ } @seen_rdgs ) {
104 print STDERR 'No manuscript found with reading "'
105 . $apparatus->{$rdg} .
106 '" at location ' . $apparatus->{_id} . "\n";
107 # delete $apparatus->{$rdg}; # for now
111 # Done with loop, so push the last apparatus.
112 push( @app_list, $apparatus );
118 This package is free software and is provided "as is" without express
119 or implied warranty. You can redistribute it and/or modify it under
120 the same terms as Perl itself.
124 Tara L Andrews, aurum@cpan.org