anne/lyx_mirror
1
0
Fork 0
mirror of https://git.lyx.org/repos/lyx.git synced 2024-11-22 01:59:02 +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); @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($$$$) sub check_http_url($$$$)
{ {
use Net::HTTP; use Net::HTTP;
@ -134,7 +142,7 @@ sub check_ftp_url($$$$)
my $found2 = 0; my $found2 = 0;
for my $f ( @{$rEntries}) { for my $f ( @{$rEntries}) {
#print "Entry: $path $f\n"; #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) { if ($res1 == 1) {
$found = 1; $found = 1;
last; last;
@ -220,17 +228,17 @@ sub check_url($)
return 2; return 2;
} }
if ($protocol =~ /^https?$/) { if ($protocol =~ /^https?$/) {
return &check_http_url($protocol, $host, $path, $file); return check_http_url($protocol, $host, $path, $file);
} }
elsif ($protocol eq "ftp") { elsif ($protocol eq "ftp") {
my $message; my $message;
($res, $message) = &check_ftp_url($protocol, $host, $path, $file); ($res, $message) = check_ftp_url($protocol, $host, $path, $file);
return $res; return $res;
} }
else { else {
# it never should reach this point # it never should reach this point
print " What protocol is '$protocol'?"; print " What protocol is '$protocol'?";
$res = &check_unknown_url($protocol, $host, $path, $file); $res = check_unknown_url($protocol, $host, $path, $file);
return $res; return $res;
} }
} }

37
development/checkurls/search_url.pl
View File

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

62
po/diff_po.pl
View File

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