view release on metacpan or  search on metacpan

lib/Lingua/Romana/Perligata.pm  view on Meta::CPAN

package Lingua::Romana::Perligata;

our $VERSION = '0.605';

use Filter::Util::Call;
use IO::Handle;
use Data::Dumper 'Dumper';
no warnings 'once';

my $offset = 0;
my $translate = 0;
my $debug = 0;

sub import {
    filter_add({});
    $offset = (caller)[2]+1;
    $translate = grep /^converte?$/i, @_[1..$#_];
    $debug = grep /^investiga?$/i, @_[1..$#_];
    $lex = grep /^discribe?$/i, @_[1..$#_];
    1;
}

$translator = q{
BEGIN {
    $SIG{__DIE__} = sub { die Lingua::Romana::Perligata::readversum($_[0]) };
    $SIG{__WARN__} = sub { return if $_[0] =~ /(...) interpreted as function/;
                   warn Lingua::Romana::Perligata::readversum($_[0]) };
}
};

sub unimport { filter_del() }

sub filter {
    my($self) = @_ ;

    my $status = 1;
    $status = filter_read(100_000);
    return $status if $status<0;
    s/\A#!.*\n//;
    s{^ \h* ecce \b .*? (?: ^ \h* ecce \h+ seco \h* $ | \Z )}{}gxmsi;
    $tokens = tokenize($_);

    my @commands;
    push @commands, conn_command($tokens,'END') while @$tokens;
    $_ = join ";\n", map { $_->translate } @commands;

    if ($translate) { print "$_;\n" and exit }
    elsif ($debug && /\S/) {
        print "=" x 72,
              "\nTranslated to:\n\n$_\n",
              "=" x 72;
    }
    $_ = "$translator\n#line $offset\n;$_";
    return $status;
}

#==========TOKENIZER============

sub adversum { " ad versum " . to_rn($_[0]->{line}) . "\n" }
sub readversum { $_[0] =~ m{(.*)at\s+(\S+)\s+line\s+(\d+)(.*)}s or return $_[0];
         return $1 . " ad $2 versum " . to_rn($3) . $4 }

sub make_range {
    my ($unit, $five, $ten) = @_;
    my ($two, $three) = ($unit x 2, $unit x 3);
    return [ "", $unit, $two, $three, $unit.$five, $five,
         $five.$unit, $five.$two, $five.$three, $unit.$ten ];
}

my @order = (
    make_range(qw{         I         V                  X          }),
    make_range(qw{         X         L                  C          }),
    make_range(qw{         C         D                  M          }),
    make_range(qw{         M         I))              ((I))        }),
    make_range(qw{       ((I))       I)))            (((I)))       }),
    make_range(qw{      (((I)))      I))))          ((((I))))      }),