anne/lyx_mirror
1
0
Fork 0
mirror of https://git.lyx.org/repos/lyx.git synced 2024-09-19 14:30:32 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity

Use prototypes in perl scripts

Browse Source
This commit is contained in:
Kornel Benko 2014-01-24 11:00:07 +01:00
parent a7a585c7bd
commit 30b6c83164
4 changed files with 91 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
development/checkurls/CheckURL.pm
View File

@ -20,6 +20,14 @@ BEGIN {
@EXPORT = qw(check_url);
}
# Prototypes
sub check_http_url($$$$);
sub check_ftp_dir_entry($$);
sub check_ftp_url($$$$);
sub check_unknown_url($$$$);
sub check_url($);
################
sub check_http_url($$$$)
{
use Net::HTTP;
@ -134,7 +142,7 @@ sub check_ftp_url($$$$)
my $found2 = 0;
for my $f ( @{$rEntries}) {
#print "Entry: $path $f\n";
my ($res1,$isdir) = &check_ftp_dir_entry($file,$f);
my ($res1,$isdir) = check_ftp_dir_entry($file,$f);
if ($res1 == 1) {
$found = 1;
last;
@ -220,17 +228,17 @@ sub check_url($)
return 2;
}
if ($protocol =~ /^https?$/) {
return &check_http_url($protocol, $host, $path, $file);
return check_http_url($protocol, $host, $path, $file);
}
elsif ($protocol eq "ftp") {
my $message;
($res, $message) = &check_ftp_url($protocol, $host, $path, $file);
($res, $message) = check_ftp_url($protocol, $host, $path, $file);
return $res;
}
else {
# it never should reach this point
print " What protocol is '$protocol'?";
$res = &check_unknown_url($protocol, $host, $path, $file);
$res = check_unknown_url($protocol, $host, $path, $file);
return $res;
}
}

37
development/checkurls/search_url.pl
View File

@ -46,6 +46,13 @@ use POSIX qw(locale_h);
setlocale(LC_CTYPE, "");
setlocale(LC_MESSAGES, "en_US.UTF-8");
# Prototypes
sub printNotUsedURLS($\%);
sub readUrls($\%);
sub parse_file($ );
sub handle_url($$$ );
##########
my %URLS = ();
my %ignoredURLS = ();
my %revertedURLS = ();
@ -61,23 +68,23 @@ for my $arg (@ARGV) {
if (open(FLIST, $val)) {
while (my $l = <FLIST>) {
chomp($l);
&parse_file($l);
parse_file($l);
}
close(FLIST);
}
}
elsif ($type eq "ignoredURLS") {
&readUrls($val, \%ignoredURLS);
readUrls($val, %ignoredURLS);
}
elsif ($type eq "revertedURLS") {
&readUrls($val, \%revertedURLS);
readUrls($val, %revertedURLS);
}
elsif ($type eq "extraURLS") {
&readUrls($val, \%extraURLS);
readUrls($val, %extraURLS);
}
elsif ($type eq "selectedURLS") {
$checkSelectedOnly = 1;
&readUrls($val, \%selectedURLS);
readUrls($val, %selectedURLS);
}
else {
die("Invalid argument \"$arg\"");
@ -102,7 +109,7 @@ for my $u (@urls) {
print "Checking '$u': ";
my ($res, $prnt);
try {
$res = &check_url($u);
$res = check_url($u);
if ($res) {
$prnt = "Failed";
}
@ -142,9 +149,9 @@ for my $u (@urls) {
}
if (%URLS) {
&printNotUsedURLS("Ignored", \%ignoredURLS);
&printNotUsedURLS("Selected", \%selectedURLS);
&printNotUsedURLS("KnownInvalid", \%extraURLS);
printNotUsedURLS("Ignored", %ignoredURLS);
printNotUsedURLS("Selected", %selectedURLS);
printNotUsedURLS("KnownInvalid", %extraURLS);
}
print "\n$errorcount URL-tests failed out of $URLScount\n\n";
@ -152,7 +159,7 @@ exit($errorcount);
###############################################################################
sub printNotUsedURLS($$)
sub printNotUsedURLS($\%)
{
my ($txt, $rURLS) = @_;
my @msg = ();
@ -171,7 +178,7 @@ sub printNotUsedURLS($$)
}
}
sub readUrls($$)
sub readUrls($\%)
{
my ($file, $rUrls) = @_;
@ -212,7 +219,7 @@ sub parse_file($)
# Outside of url, check also
if ($l =~ /"((ftp|http|https):\/\/[^ ]+)"/) {
my $url = $1;
&handle_url($url, $f, "x$line");
handle_url($url, $f, "x$line");
}
}
}
@ -224,14 +231,14 @@ sub parse_file($)
if ($l =~ /\s*([a-z]+:\/\/.+)\s*$/) {
my $url = $1;
$status = "out";
&handle_url($url, $f, "u$line");
handle_url($url, $f, "u$line");
}
}
elsif ($status eq "inHrefInset") {
if ($l =~ /^target\s+"([a-z]+:\/\/[^ ]+)"$/) {
my $url = $1;
$status = "out";
&handle_url($url, $f, "h$line");
handle_url($url, $f, "h$line");
}
}
}
@ -246,6 +253,8 @@ sub handle_url($$$)
if(!defined($URLS{$url})) {
$URLS{$url} = {};
}
if(!defined($URLS{$url}->{$f})) {
$URLS{$url}->{$f} = [];
}
push(@{$URLS{$url}->{$f}}, $line);

62
po/diff_po.pl
View File

@ -69,6 +69,18 @@ BEGIN {
unshift(@INC, "$p");
}
# Prototypes
sub get_env_name($ );
sub buildParentDir($$);
sub searchRepo($);
sub diff_po(@);
sub check_po_file_readable($$);
sub printDiff($$$$);
sub printIfDiff($$$);
sub printExtraMessages($$$);
sub getrev($$$);
#########
use strict;
use parsePoLine;
use Term::ANSIColor qw(:constants);
@ -106,7 +118,7 @@ sub get_env_name($)
# svn: needed to pass options through --diff-cmd parameter
# hg: needed to pass options through extdiff parameter
for my $opt (keys %options) {
my $e = &get_env_name($opt);
my $e = get_env_name($opt);
if (defined($e)) {
if (defined($ENV{$e})) {
$options{$opt} = $ENV{$e};
@ -118,7 +130,7 @@ while (($opt=$ARGV[0]) =~ s/=(\d+)$//) {
$val = $1;
if (defined($options{$opt})) {
$options{$opt} = $val;
my $e = &get_env_name($opt);
my $e = get_env_name($opt);
if (defined($e)) {
$ENV{$e} = $val;
}
@ -153,7 +165,7 @@ if ($ARGV[0] =~ /^-r(.*)/) {
$filedir = ".";
}
$filedir = getcwd();
my ($repo, $level) = &searchRepo($filedir);
my ($repo, $level) = searchRepo($filedir);
my $relargf = $baseargf; # argf relative to the top-most repo directory
my $topdir;
if (defined($level)) {
@ -173,11 +185,11 @@ if ($ARGV[0] =~ /^-r(.*)/) {
exit(-1);
}
#check po-file
&check_po_file_readable($baseargf, $relargf);
check_po_file_readable($baseargf, $relargf);
if ($repo eq ".git") {
my @args = ();
my $tmpfile = File::Temp->new();
$rev = &getrev($repo, $rev, $argf);
$rev = getrev($repo, $rev, $argf);
push(@args, "-L", $argf . " (" . $rev . ")");
push(@args, "-L", $argf . " (local copy)");
print "git show $rev:$relargf\n";
@ -190,11 +202,11 @@ if ($ARGV[0] =~ /^-r(.*)/) {
$tmpfile->seek( 0, SEEK_END ); # Flush()
push(@args, $tmpfile->filename, $argf);
print "===================================================================\n";
&diff_po(@args);
diff_po(@args);
}
elsif ($repo eq ".svn") {
# program svnversion needed here
$rev = &getrev($repo, $rev, $argf);
$rev = getrev($repo, $rev, $argf);
# call it again indirectly
my @cmd = ("svn", "diff", "-r$rev", "--diff-cmd", $0, $relargf);
print "cmd = " . join(' ', @cmd) . "\n";
@ -206,7 +218,7 @@ if ($ARGV[0] =~ /^-r(.*)/) {
# [extensions]
# hgext.extdiff =
#
$rev = &getrev($repo, $rev, $argf);
$rev = getrev($repo, $rev, $argf);
my @cmd = ("hg", "extdiff", "-r", "$rev", "-p", $0, $relargf);
print "cmd = " . join(' ', @cmd) . "\n";
system(@cmd);
@ -214,20 +226,20 @@ if ($ARGV[0] =~ /^-r(.*)/) {
}
}
else {
&diff_po(@ARGV);
diff_po(@ARGV);
}
exit($result);
#########################################################
# This routine builds n-th parent-path
# E.g. &buildParentDir("abc", 1) --> "abc/.."
# &buildParentDir("abc", 4) --> "abc/../../../.."
# E.g. buildParentDir("abc", 1) --> "abc/.."
# buildParentDir("abc", 4) --> "abc/../../../.."
sub buildParentDir($$)
{
my ($dir, $par) = @_;
if ($par > 0) {
return &buildParentDir("$dir/..", $par-1);
return buildParentDir("$dir/..", $par-1);
}
else {
return $dir;
@ -240,7 +252,7 @@ sub searchRepo($)
{
my ($dir) = @_;
for my $parent ( 0 .. 10 ) {
my $f = &buildParentDir($dir, $parent);
my $f = buildParentDir($dir, $parent);
for my $s (".git", ".svn", ".hg") {
if (-d "$f/$s") {
#print "Found repo on level $parent\n";
@ -251,7 +263,7 @@ sub searchRepo($)
return(""); # not found
}
sub diff_po($$)
sub diff_po(@)
{
my @args = @_;
%Messages = ();
@ -282,13 +294,13 @@ sub diff_po($$)
die("names = \"", join('" "', @names) . "\"... args = \"" . join('" "', @args) . "\" Expected exactly 2 parameters");
}
&check_po_file_readable($names[0], $args[0]);
&check_po_file_readable($names[1], $args[1]);
check_po_file_readable($names[0], $args[0]);
check_po_file_readable($names[1], $args[1]);
&parse_po_file($args[0], \%Messages);
&parse_po_file($args[1], \%newMessages);
parse_po_file($args[0], %Messages);
parse_po_file($args[1], %newMessages);
my @MsgKeys = &getLineSortedKeys(\%newMessages);
my @MsgKeys = getLineSortedKeys(%newMessages);
print RED "<<< \"$names[0]\"\n", RESET;
print GREEN ">>> \"$names[1]\"\n", RESET;
@ -305,7 +317,7 @@ sub diff_po($$)
}
}
if (exists($Messages{$k})) {
&printIfDiff($k, $Messages{$k}, $newMessages{$k});
printIfDiff($k, $Messages{$k}, $newMessages{$k});
delete($Messages{$k});
delete($newMessages{$k});
}
@ -333,7 +345,7 @@ sub diff_po($$)
}
}
else {
@MsgKeys = &getLineSortedKeys(\%Messages);
@MsgKeys = getLineSortedKeys(%Messages);
for my $k (@MsgKeys) {
$result |= 8;
print "deleted message\n";
@ -343,7 +355,7 @@ sub diff_po($$)
print RED "< msgstr = \"" . $Messages{$k}->{msgstr} . "\"\n", RESET;
}
@MsgKeys = &getLineSortedKeys(\%newMessages);
@MsgKeys = getLineSortedKeys(%newMessages);
for my $k (@MsgKeys) {
$result |= 16;
print "new message\n";
@ -354,10 +366,10 @@ sub diff_po($$)
}
}
if ($options{"--display-fuzzy"}) {
&printExtraMessages("fuzzy", \%Fuzzy, \@names);
printExtraMessages("fuzzy", \%Fuzzy, \@names);
}
if ($options{"--display-untranslated"}) {
&printExtraMessages("untranslated", \%Untranslated, \@names);
printExtraMessages("untranslated", \%Untranslated, \@names);
}
}
@ -407,7 +419,7 @@ sub printIfDiff($$$)
$doprint = 1 if ($rM->{msgstr} ne $rnM->{msgstr});
if ($doprint) {
$result |= 4;
&printDiff($k, $k, $rM, $rnM);
printDiff($k, $k, $rM, $rnM);
}
}

31
po/parsePoLine.pm
View File

@ -1,3 +1,4 @@
# -*- mode: perl; -*-
package parsePoLine;
use strict;
@ -6,10 +7,16 @@ our(@EXPORT, @ISA);
BEGIN {
use Exporter ();
@ISA = qw(Exporter);
@EXPORT = qw(parse_po_file getLineSortedKeys);
@ISA = qw(Exporter);
@EXPORT = qw(parse_po_file getLineSortedKeys);
}
# Prototypes
sub parse_po_file($\%);
sub parse_po_line($$$$$ );
sub getLineSortedKeys(\%);
############
my ($status, $foundline, $msgid, $msgstr, $fuzzy);
@ -17,7 +24,7 @@ my $alternative = 0;
my @entry = ();
my %entries = ();
sub parse_po_file($$)
sub parse_po_file($\%)
{
$alternative = 0;
@entry = ();
@ -32,11 +39,11 @@ sub parse_po_file($$)
my $lineno = 0;
while (my $line = <FI>) {
$lineno++;
&parse_po_line($line, $lineno, $rMessages, \@result, \$resindex);
parse_po_line($line, $lineno, $rMessages, \@result, \$resindex);
push(@entry, $line);
}
&parse_po_line("", $lineno + 1, $rMessages, \@result, \$resindex);
parse_po_line("", $lineno + 1, $rMessages, \@result, \$resindex);
my @entr1 = @entry;
$result[$resindex] = ["zzzzzzzzzzzz", \@entr1];
close(FI);
@ -44,7 +51,7 @@ sub parse_po_file($$)
return(@result);
}
sub parse_po_line($$$$$)
sub parse_po_line($$$$$)
{
my ($line, $lineno, $rMessages, $rresult, $rresindex) = @_;
chomp($line);
@ -58,14 +65,14 @@ sub parse_po_line($$$$$)
$foundline = $lineno;
$status = "msgid";
$msgid = "";
&parse_po_line($line, $lineno, $rMessages, $rresult, $rresindex);
parse_po_line($line, $lineno, $rMessages, $rresult, $rresindex);
}
elsif ($line =~ s/^\#\~ msgid\s+//) {
$alternative = 1;
$foundline = $lineno;
$status = "msgid";
$msgid = "";
&parse_po_line($line, $lineno, $rMessages, $rresult, $rresindex);
parse_po_line($line, $lineno, $rMessages, $rresult, $rresindex);
}
}
elsif ($status eq "msgid") {
@ -80,13 +87,13 @@ sub parse_po_line($$$$$)
$alternative = 0;
$status = "msgstr";
$msgstr = "";
&parse_po_line($line, $lineno, $rMessages, $rresult, $rresindex);
parse_po_line($line, $lineno, $rMessages, $rresult, $rresindex);
}
elsif ($line =~ s/^\#\~ msgstr\s+//) {
$alternative = 1;
$status = "msgstr";
$msgstr = "";
&parse_po_line($line, $lineno, $rMessages, $rresult, $rresindex);
parse_po_line($line, $lineno, $rMessages, $rresult, $rresindex);
}
}
elsif ($status eq "msgstr") {
@ -129,7 +136,7 @@ sub parse_po_line($$$$$)
}
}
sub getLineSortedKeys($)
sub getLineSortedKeys(\%)
{
my ($rMessages) = @_;
@ -154,7 +161,7 @@ parsePoLine
use parsePoLine; #imports functions 'parse_po_file() and getLineSortedKeys()'
my %Messages = ();
my @entries = parse_po_file("sk.po", \%Messages);
my @entries = parse_po_file("sk.po", %Messages);
=head1 DESCRIPTION