App-Bernard

 view release on metacpan or  search on metacpan

lib/App/Bernard.pm  view on Meta::CPAN

	'o|output=s'      => \$settings{'output'},
	's|script=s'      => \$settings{'script'},
	'i|in-place'      => \$settings{'inplace'},
	'n|names=s'       => \$settings{'names'},
	'h|?|help'        => \$settings{'help'},
	'c|check'         => \$settings{'check'},
	'm|magic=s'       => \$settings{'magic'},
	'e|expression=s@' => \$settings{'expression'},
	);

    if (scalar(@ARGV)==0) {
	$settings{'help'} = 1 unless $settings{'expression'};
    } elsif (scalar(@ARGV)>1) {
	die "Can work on at most one file at once\n";
    } else {
	$settings{'input'} = $ARGV[0];
    }

    if ($settings{'inplace'}) {
	die "--in-place cannot be used with --output\n"
	    if $settings{'output'};
	
	die "--in-place cannot be used with standard input\n"
	    unless $settings{'input'};

	$settings{'output'} = $settings{'input'}.'.'.rand();
    }

    my %known_alphabets = ( latn=>1, shaw=>1 );
    $settings{'script'} = lc $settings{'script'};

    die "Alphabet $settings{'script'} is unknown\n"
	unless defined $known_alphabets{$settings{'script'}};

    die "Can't check standard output\n"
	if $settings{'check'} && !defined($settings{'output'});

    if ($settings{'help'}) {
	if (system("man bernard")!=0) {
	    print "Sorry, I can't launch the help program.\n";
	}
	exit;
    }
}

################################################################

sub print_expressions {
    for my $expression (@{$settings{'expression'}}) {
	print $settings{'transliterate'}->($expression), "\n";
    }

    exit if scalar(@ARGV)==0;
}

################################################################


sub execute {

    binmode STDOUT, ":utf8";

    parse_command_line();

    if ($settings{'script'} eq 'latn') {
	$settings{'transliterate'} = sub {
	    my ($text) = @_;
	    return $text;
	};
    } else {
	my $leas = Lingua::EN::Alphabet::Shaw->new();

	$settings{'transliterate'} = sub {
	    my ($text) = @_;

	    $settings{'underscore'} = 0 if $text =~ /%\(/;

	    if ($settings{'underscore'}) {
		$text =~ s/_/_ /g;
		$text =~ s/([a-z]+)_ ([a-z]+)/_ $1$2/gi;
	    }

	    for my $lhs (keys(%{$settings{'defines'}})) {
		my $rhs = $settings{'defines'}->{$lhs};
		$text =~ s/\b$lhs\b/$rhs/gi;
	    }

	    # split out Python interpolation
	    my @text = split /(%\([^)]*\)[^a-z]*[a-z])/, $text;

	    $text = $leas->transliterate(@text);

	    if ($settings{'underscore'}) {
		$text =~ s/_ /_/g;
	    }

            return $text;
        };
    }

    print_expressions();

    # now do the magic

    my $magic = undef;
    my $m = lc $settings{'magic'};
    my $pkg = "App::Bernard::Magic::\u$m";

    eval {
	my $filename = $pkg;
	$filename =~ s!::!/!g;
	require "$filename.pm";

	$magic = $pkg->new();
    };

    if ($@) {
       die "Magic $settings{'magic'} is not known\n"
	   if $@ =~ /Can't locate/;
       die "Error in loading magic $settings{'magic'}: $@\n";
    }



( run in 0.499 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )