Free2Code
 
Time: 2008-11-21, 01:28am
chnging perl code
Subject: chnging perl code  ·  Posted: 2005-02-17, 12:20pm
Rank: ? (9)
Member #: 23454
i have no knowledge of perl but i need to change a perl module so that text is sent into it and held in a variable. Currently it takes a text file from the dos prompt. There are also other changes that would need to be made because i can see that there is a whole section that hecks whether the file exists, etc.

The main thing is i cannot see what holds the text from the text file and therefore i cannot change it to a variable and set it to a line of text.

Im not sure if im making sense but i would greatly appreciate any help as i am pretty desperate

I am printing the code below

#!/usr/bin/perl
# This is a command-line front end to An Gramadoir,
# an open-source Irish language grammar checker.
# Copyright (C) 2004 Kevin P. Scannell <scannell@slu.edu>
#
# This script will check the grammar of Irish language text files
# specified on the command line, or read from standard input if no arguments
# are given. The default behavior is to write a summary of possible errors
# to standard output.
#
# Use "--help" to see a list of available command line options.
# More detailed information is available from the project web page:
# http://borel.slu.edu/gramadoir/
#
# This is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself, either Perl version 5.8.2 or,
# at your option, any later version of Perl 5 you may have available.

use strict;
use warnings;

use Getopt::Long qw(:config gnu_getopt);
use Term::ANSIColor;
use Lingua::GA::Gramadoir;
use Lingua::GA::Gramadoir::Languages;
# use open OUT => ':utf8'; # bad bad bad
# gram-ga.pl -v
# != gram-ga.pl -v > file; cat file

my $lh;
my $clar;
my $VERSION = '0.50';

sub gettext
{
my $string = shift;

$string =~ s/\\n/\n/g;
$string =~ s/\[/~[/g;
$string =~ s/\]/~]/g;
$string =~ s/\%s/[_1]/;
return $lh->maketext($string, @_);
}

sub localized_die
{
my ( $signal ) = @_;
my $dieclar = gettext('An Gramadoir'); # can't use global $clar yet

if ( $signal =~ m/^getopt/ ) {
my $msg = gettext('error parsing command-line options');
my $helper = $0;
$helper =~ s#^.*/([^/]+)$#$1 --help#;
my $tryhelp = gettext('Try %s for more information.', $helper);
print STDERR "$dieclar: $msg\n$tryhelp\n";
exit 1;
}
elsif ( $signal =~ m/^gram: maketext (.*)/ ) {
my $msg = gettext('Language %s is not supported.', $1);
print STDERR "$dieclar: $msg\n";
exit 1;
}
else {
die $signal;
}
}

$lh = Lingua::GA::Gramadoir::Languages->get_handle();
$SIG{__DIE__} = 'localized_die';
my $api = '';
my $aschur = '';
my $aspell = '';
my $comheadan = '';
my $dath = 'bold red';
my $help = '';
my $html = '';
my $iomlan = '';
my $ionchod = 'ISO-8859-1';
my $aschod = 'utf8';
my $litriu = '';
my $version = '';
my $xml = '';
GetOptions (
'all|iomlan|a' => \$iomlan,
'api' => \$api,
'aspell|moltai' => \$aspell,
'list|litriu|l' => \$litriu,
'color|colour|dath=s' => \$dath,
'incode|ionchod|f=s' => \$ionchod,
'outcode|aschod|t=s' => \$aschod,
'help|cabhair|h' => \$help,
'html' => \$html,
'interface|comheadan=s' => \$comheadan,
'output|aschur|o=s' => \$aschur,
'version|leagan|v' => \$version,
'xml' => \$xml,
) or die "getopt error";

if ($aschur) {
unless ($^O eq 'MSWin32') {
$aschur =~ s#^~(\w*)#$1 ? (getpwnam($1))[7] : ( $ENV{HOME} || $ENV{LOGDIR} || (getpwuid($>)[7] )#e;
}
open(OUTSTREAM, ">:encoding($aschod)", $aschur) or
warn "Can't open $aschur: $!\n";
}
else {
open(OUTSTREAM, ">&=STDOUT" or
warn "Couldn't alias STDOUT: $!\n";
binmode OUTSTREAM, ":encoding($aschod)"; # must be after alias
}

if ($comheadan) {
$lh = Lingua::GA::Gramadoir::Languages->get_handle($comheadan);
die "gram: maketext $comheadan" unless $lh;
}
# $lh->fail_with('failure_handler_auto');

# TRANSLATORS: Please leave untranslated, but add an acute accent to the
# "o" in "Gramadoir" if available in your character set and encoding.
# If you must translate, this is the Irish for (literally) "The Grammarian"
$clar = gettext('An Gramadoir');

if ($version) {
my $vstring = gettext('version %s', $VERSION);
my $copyright = 'Copyright (C) 2003, 2004 Kevin P. Scannell';
my $gpl = gettext('This is free software; see the source for copying conditions. There is NO\\nwarranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE,\\nto the extent permitted by law.');
if ($html) {
$copyright =~ s#(Kevin P. Scannell)#<a href="http://borel.slu.edu/">$1</a><br><br>#;
print OUTSTREAM "<p>\n<a href=\"http://borel.slu.edu/gramadoir/\">$clar</a>, $vstring<br>\n$copyright\n<i>$gpl</i></p><hr>\n";
}
else {
print OUTSTREAM "$clar, $vstring\n$copyright\n$gpl\n";
}
close OUTSTREAM;
exit 0;
}
if ($help) {
my @helpmessages = (
gettext(
'Usage: %s [OPTIONS] [FILES]'),
"",
gettext(
"Options for end-users:",
# TRANSLATORS: ~/.neamhshuim is an "ignore file" like those with spellcheckers
" -a, --all,",
gettext(
" --iomlan report all errors (i.e. do not use ~/.neamhshuim)",
" -f, --incode,",
gettext(
" --ionchod=ENC specify the character encoding of the text to be checked",
" -t, --outcode,",
gettext(
" --aschod=ENC specify the character encoding for output",
" --interface,",
gettext(
" --comheadan=xx choose the language for error messages",
" --color, --colour,",
gettext(
" --dath=COLOR specify the color to use for highlighting errors",
" -l, --list,",
gettext(
" --litriu write misspelled words to standard output",
" --moltai,",
gettext(
" --aspell suggest corrections for misspellings",
" -o, --output,",
gettext(
" --aschur=FILE write output to FILE",
" -h, --cabhair,",
gettext(
" --help display this help and exit",
" -v, --leagan,",
gettext(
" --version output version information and exit",
"",
gettext(
"Options for developers:",
gettext(
" --api output a simple XML format for use with other applications",
gettext(
" --html produce HTML output for viewing in a web browser",
# TRANSLATORS: The grammar checker works by passing the input text
# through a sequence of filters which add XML markup indicating
# important grammatical information. The --xml option displays the
# marked up file as an aid in debugging.
gettext(
" --xml write tagged XML stream to standard output, for debugging",
"",
gettext(
"If no file is given, read from standard input.",
"",
gettext(
'Send bug reports to <%s>.','scannell@slu.edu'),
""
);

print OUTSTREAM join("\n", @helpmessages);
close OUTSTREAM;
exit 0;
}

my $gr = new Lingua::GA::Gramadoir(
fix_spelling => $aspell,
use_ignore_file => ! $iomlan,
interface_language => $comheadan,
input_encoding => $ionchod,
);

binmode STDIN, ":bytes";
unshift(@ARGV, '-') unless @ARGV;
while ($ARGV = shift @ARGV) {
unless ($ARGV eq "-" {
unless ( -e $ARGV ) {
warn "$clar: $ARGV: ".gettext('There is no such file.')."\n";
next;
}
if ( -d $ARGV ) {
warn "$clar: $ARGV: ".gettext('Is a directory')."\n";
next;
}
unless ( -f $ARGV ) {
warn "$ARGV is Not a plain file\n";
next;
}
unless ( -r $ARGV ) {
warn "$clar: $ARGV: ".gettext('Permission denied')."\n";
next;
}
unless (open(ARGV, "<:bytes", $ARGV)) {
warn "Can't open $ARGV: $!\n";
next;
}
}
local $/; # slurp a file at a time
$_ = <ARGV>;
close ARGV;
if ($litriu) {
my $missp = $gr->spell_check($_);
foreach (@$missp) {
print OUTSTREAM "$_\n";
}
}
elsif ($xml) {
print OUTSTREAM $gr->xml_stream($_);
}
elsif ($api) {
my $apierr = $gr->grammatical_errors($_);
foreach (@$apierr) {
print OUTSTREAM "$_\n";
}
}
else { # vanilla or html
my $status = gettext('Currently checking %s', $ARGV);
print OUTSTREAM "$status\n" unless ($ARGV eq "-";
my $errs = $gr->grammatical_errors($_);
foreach my $error (@$errs) {
$error =~ m/^<E offset="([0-9]+)" fromy="([0-9]+)".* sentence="(.*)" errortext="([^"]+)" msg="([^"]+)">$/;
my $s = "<br><br>$2: ".substr($3,0,$1);
if ($html) {
$s .= "<b class=gramadoir>$4</b>";
}
else {
if ($dath eq "none" {
$s .= $4;
}
else {
$s .= colored($4,$dath);
}
}
$s .= substr($3,$1+length($4));
$s .= "<br>\n$5.\n\n";
if (!$html) {
$s =~ s/<br>//g;
$s =~ s/&quot;/"/g;
$s =~ s/&lt;/</g;
$s =~ s/&gt;/>/g;
$s =~ s/&amp;/&/g;
}
print OUTSTREAM $s;
} # loop over errors
} # vanilla/html block
} # loop over files

close OUTSTREAM;
exit 0;


 
  Reply to this ·  Post link ·  Top

Pages: 1

Please login or register to post a reply.

icons