script/strip_punctuation.pl

   1 #!/usr/bin/env perl
   2
   3 use lib 'lib';
   4 use strict;
   5 use warnings;
   6 use Text::Tradition::Directory;
   7
   8 binmode STDERR, ':utf8';
   9
  10 my( $dsn, $user, $pass ) = @ARGV;
  11
  12 my $connect_args = { dsn => $dsn };
  13 $connect_args->{'extra_args'} = { user => $user, password => $pass }
  14         if $user && $pass;
  15 my $dir = Text::Tradition::Directory->new( $connect_args );
  16
  17 foreach my $text ( $dir->traditionlist ) {
  18         my $id = $text->{'id'};
  19         my $scope = $dir->new_scope;
  20         my $tradition = $dir->lookup( $id );
  21         print STDERR "Processing tradition " . $tradition->name . "\n";
  22         foreach my $reading ( $tradition->collation->readings ) {
  23                 next if $reading->is_meta;
  24                 $reading->alter_text( strip_punct( $reading->text ) );
  25         }
  26         $tradition->collation->flatten_ranks;
  27         $dir->save( $tradition );
  28 }
  29
  30 print STDERR "Done\n";
  31
  32 sub strip_punct {
  33         my( $rtext ) = @_;
  34         my $orig_r = $rtext;
  35         return $rtext unless $rtext =~ /\w/;
  36         $rtext =~ s/^\W+//;
  37         $rtext =~ s/\W+$//;
  38         print STDERR "Altering $orig_r to $rtext\n"
  39                 unless $orig_r eq $rtext;
  40         return $rtext;
  41 }
  42