1 package Text::Tradition::Parser::CSV;
9 Text::Tradition::Parser::CSV
13 Parser module for Text::Tradition, given a list of variants as a CSV
14 file and a reference text as a plaintext file with appropriate line
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( $ARGV[0] );
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 push( @app_list, $apparatus ) if keys %$apparatus;
59 $apparatus = { _id => $linehash{reference},
63 # The apparatus has multiple readings, and multiple witnesses per
64 # reading. So it's a hashref whose values are listrefs.
65 $apparatus->{ 'rdg_0' } = $linehash{ 'text' }
66 if $linehash{ 'text' };
67 $apparatus->{ 'rdg_' . ++$rdg_ctr } = $linehash{ 'variant' };
68 foreach my $attr ( @fields[3..8] ) {
69 $apparatus->{"_rdg_${rdg_ctr}_$attr"} = $linehash{ $attr }
70 if $linehash{ $attr };
73 foreach my $k ( @fields[10..$#fields] ) {
74 my $variant_rdg = $linehash{$k};
75 $k =~ s/\s+\(a\.c\.\)//;
76 if( $variant_rdg =~ /^0/ ) {
77 $apparatus->{ $k } = 'rdg_0'
78 unless exists $apparatus->{ $k };
79 } elsif ( $variant_rdg =~ /^1/ ) {
80 $apparatus->{ $k } = 'rdg_' . $rdg_ctr;
81 } else { # else for $, we don't list the MS
82 warn "Unparsed variant indicator $variant_rdg for $k in " .
84 unless ( !$variant_rdg or $variant_rdg =~ /^\$$/ );
87 # See if we have at least one reading for each variant.
88 my @seen_rdgs = values %$apparatus;
89 foreach my $rdg ( grep { $_ =~ /^rdg/ } keys %$apparatus ) {
90 unless( grep { $_ =~ /^$rdg$/ } @seen_rdgs ) {
91 print STDERR 'No manuscript found with reading "'
92 . $apparatus->{$rdg} .
93 '" at location ' . $apparatus->{_id} . "\n";
94 # delete $apparatus->{$rdg}; # for now
98 # Done with loop, so push the last apparatus.
99 push( @app_list, $apparatus );
107 This package is free software and is provided "as is" without express
108 or implied warranty. You can redistribute it and/or modify it under
109 the same terms as Perl itself.
113 Tara L Andrews, aurum@cpan.org