[Steak-developer] Perl-version
Brought to you by:
razilotfi
|
From: Joerg S. <jo...@al...> - 2002-09-07 16:27:01
|
Hier nun mal mein endg=FCltiges Perlprogramm:
#v+
#!/usr/bin/perl -w #T
#
# Copyright (c) 2002 Razi Lotfi-Tabrizi <ra...@cs...>
#
# License: This script is distributed under the terms of version 2
# of the GNU GPL. See the LICENSE file included with the packa=
ge.
#
my $VERSION=3D"1.8.0";
=20
use Getopt::Long;
use strict;
use warnings;
my $xcb=3D"/usr/bin/X11/xcb";
my $xcb_opt=3D"-p 0";
my $use_xbuf=3D0;
my $trans=3D"de-en";
my @dicts=3D (["/usr/share/trans/de-en", "de", "en"],
["/dev/null", "de", "fr"],
[$ENV{"HOME"}."/.en-de", "en", "de"]);
my %LANGS=3D (de =3D> "German",
en =3D> "English",
fr =3D> "French");
my $usage=3D"usage: steak [options] [word]...\n".
"Options:\n".
" --and|--or concatenate the word with \"and\"(default) or =
\"or\"\n".
" --[no]clipboard take the word from the X cut buffer if none is=
given\n".
" at the command line (default: true)\n".
" -i|--[no]ignore search case insensitiv\n".
" -V|--version print version\n".
" --help print this help message\n";
# parse config
# parse options
my $andor=3D1;
my $version=3D0;
my $help=3D0;
my $ignore_case=3D0;
unless ( GetOptions('and' =3D> sub { $andor=3D1; },
'or' =3D> sub { $andor=3D0; },
'clipboard!' =3D> \$use_xbuf,
'i|ignore!' =3D> \$ignore_case,
'trans=3Ds' =3D> \$trans,
'V|version' =3D> \$version,
'help' =3D> \$help) ) {
print($usage);
exit(1);
}
my @words=3D@ARGV;
if ($version) {
print("steak: $VERSION\n");
exit(0);
}
if ($help) {
print($usage);
exit(0);
}
if (@words =3D=3D 0 && $use_xbuf && -x $xcb) {
open(XBUF, "-|", "$xcb $xcb_opt") || die;
@words =3D <XBUF>;
close(XBUF);
}
if (@words =3D=3D 1 && $words[0] eq "-") {
shift(@words);
my $i=3D1;
while (1) {
print "word $i: ";
my $word =3D <>;
last if (! defined $word || $word eq "\n");
push(@words, $word);
++$i;
}
}
die "No words for translation given\n" if (@words =3D=3D 0);
my ($lang1, $lang2) =3D ($trans =3D~ /([[:alpha:]]{2})-([[:alpha:]]{2})/)=
;
my @files;
foreach (@dicts) {
my ($file, $lang_l, $lang_r) =3D @{$_};
next if (! -r $file);
=20
if ($lang1 eq $lang_l && $lang2 eq $lang_r) {
push @files, [ $file, 0 ];
} elsif ($lang1 eq $lang_r && $lang2 eq $lang_l) {
push @files, [ $file, 1 ];
}
}
undef @dicts;
die "No dictionaries found for this language" if ( $#files =3D=3D -1);
print(" --------------------------------------------------\n=
");
print " " foreach (1..(37-length($LANGS{$lang1})));
print "$LANGS{$lang1} -> $LANGS{$lang2}\n";
@words =3D map(quotemeta(), @words);
foreach my $f (@files) {
my ($file, $side) =3D @$f;
my @regexp;
if ($andor) {
if ($side=3D=3D0) { # left side
$_ .=3D ".*::" foreach(@words);
} else { # right side
$_ =3D "::.*$_" foreach(@words);
}
@regexp =3D @words;
} else {
my $help;
if (@words =3D=3D 1) {
$help =3D $words[0];
} else {
$help =3D '('.join('|', @words).')';
}
=09
if ($side=3D=3D0) { # left side
$help .=3D ".*::";
} else { # right side
$help =3D "::.*$help";
}
push(@regexp, $help);
}
open(DICT, "<", $file) || die "Cannot open dictionary file \"$file\":=
$!";
my $check;
foreach (@regexp) {
$check .=3D 'next if ($_ !~ /'.$_.'/'.($ignore_case?'i':'').');';
}
eval('while(<DICT>) {'.
'next if (/^#/);'.
$check.=20
'chomp($_);'.
($side=3D=3D0?
's/^ *(.*) *:: *(.*) *$/$1 :=3D=3D $2/;'
:
's/^ *(.*) *:: *(.*) *$/$2 :=3D=3D $1/;').
'print $_,"\n";'.
'}');
close(DICT) || die "Cannot close file: $!";
}
#v-
|