anne/lyx_mirror
1
0
Fork 0
mirror of https://git.lyx.org/repos/lyx.git synced 2024-11-27 19:59:46 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity

Cmake build tests: check urls optimized

Browse Source 
Copied from master
This commit is contained in:
Kornel Benko 2024-10-07 22:32:03 +02:00
parent fd6f8c28c3
commit 02e446af9c
2 changed files with 317 additions and 203 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
development/checkurls/CheckURL.pm
View File

@ -1,5 +1,6 @@
# -*- mode: perl; -*- # -*- mode: perl; -*-
package CheckURL; package CheckURL;
# file CheckURL.pm # file CheckURL.pm
# #
# This file is part of LyX, the document processor. # This file is part of LyX, the document processor.
@ -14,6 +15,7 @@ package CheckURL;
use strict; use strict;
our (@EXPORT, @ISA); our (@EXPORT, @ISA);
BEGIN { BEGIN {
use Exporter (); use Exporter ();
@ISA = qw(Exporter); @ISA = qw(Exporter);
@ -25,16 +27,18 @@ sub check_http_url($$$$);
sub check_ftp_dir_entry($$); sub check_ftp_dir_entry($$);
sub check_ftp_url($$$$); sub check_ftp_url($$$$);
sub check_unknown_url($$$$); sub check_unknown_url($$$$);
sub check_url($$); sub check_url($$$$);
################ ################
sub check_http_url($$$$) my $fe;
{ my $fs;
sub check_http_url($$$$) {
require LWP::UserAgent; require LWP::UserAgent;
my ($protocol, $host, $path, $file) = @_; my ($protocol, $host, $path, $file) = @_;
my $ua = LWP::UserAgent->new; my $ua = LWP::UserAgent->new(timeout => 20);
my $getp = "/"; my $getp = "/";
if ($path ne "") { if ($path ne "") {
$getp .= $path; $getp .= $path;
@ -54,7 +58,7 @@ sub check_http_url($$$$)
$buf = $response->decoded_content; $buf = $response->decoded_content;
} }
else { else {
print " " . $response->status_line . ": "; print $fe " " . $response->status_line . ": ";
return 3; return 3;
} }
my @title = (); my @title = ();
@ -66,9 +70,9 @@ sub check_http_url($$$$)
$title =~ s/^ //; $title =~ s/^ //;
$title =~ s/ $//; $title =~ s/ $//;
push(@title, $title); push(@title, $title);
print "title = \"$title\": "; print $fe "title = \"$title\": ";
if ($title =~ /Error 404|Not Found/) { if ($title =~ /Error 404|Not Found/) {
print " Page reports 'Not Found' from \"$protocol://$host$getp\": "; print $fe " Page reports 'Not Found' from \"$protocol://$host$getp\": ";
$res = 3; $res = 3;
} }
} }
@ -79,13 +83,12 @@ sub check_http_url($$$$)
# returns 0, x if file does not match entry # returns 0, x if file does not match entry
# 1, x everything OK # 1, x everything OK
# 2, x if not accesible (permission) # 2, x if not accesible (permission)
sub check_ftp_dir_entry($$) sub check_ftp_dir_entry($$) {
{
my ($file, $e) = @_; my ($file, $e) = @_;
my $other = '---'; my $other = '---';
my $isdir = 0; my $isdir = 0;
#print "Checking '$file' against '$e'\n"; #print $fe "Checking '$file' against '$e'\n";
$file =~ s/^\///; $file =~ s/^\///;
$isdir = 1 if ($e =~ /^d/); $isdir = 1 if ($e =~ /^d/);
return (0, $isdir) if ($e !~ /\s$file$/); return (0, $isdir) if ($e !~ /\s$file$/);
@ -93,25 +96,26 @@ sub check_ftp_dir_entry($$)
$other = $1; $other = $1;
} }
else { else {
#print "Invalid entry\n"; #print $fe "Invalid entry\n";
# Invalid entry # Invalid entry
return (0, $isdir); return (0, $isdir);
} }
return (2, $isdir) if ($other !~ /^r/); # not readable return (2, $isdir) if ($other !~ /^r/); # not readable
if ($isdir) { if ($isdir) {
#return(2,$isdir) if ($other !~ /x$/); # directory, but not executable #return(2,$isdir) if ($other !~ /x$/); # directory, but not executable
} }
return (1, $isdir); return (1, $isdir);
} }
sub check_ftp2_url($$$$) sub check_ftp2_url($$$$) {
{
my ($protocol, $host, $path, $file) = @_; my ($protocol, $host, $path, $file) = @_;
my $checkentry = 1; my $checkentry = 1;
print "\nhost $host\n";
print "path $path\n"; #print $fe "\nhost $host\n";
print "file $file\n"; #print $fe "path $path\n";
#print $fe "file $file\n";
my $url = "$protocol://$host"; my $url = "$protocol://$host";
$path =~ s/\/$//; $path =~ s/\/$//;
if (defined($file)) { if (defined($file)) {
@ -120,7 +124,8 @@ sub check_ftp2_url($$$$)
else { else {
$url = "$url/$path/."; $url = "$url/$path/.";
} }
print "curl $url, file = $file\n";
#print $fe "curl $url, file = $file\n";
my %listfiles = (); my %listfiles = ();
if (open(FFTP, "curl --anyauth -l $url|")) { if (open(FFTP, "curl --anyauth -l $url|")) {
while (my $l = <FFTP>) { while (my $l = <FFTP>) {
@ -148,15 +153,14 @@ sub check_ftp2_url($$$$)
} }
} }
sub check_ftp_url($$$$) sub check_ftp_url($$$$) {
{
use Net::FTP; use Net::FTP;
my ($protocol, $host, $path, $file) = @_; my ($protocol, $host, $path, $file) = @_;
my $res = 0; my $res = 0;
my $message = ""; my $message = "";
my $ftp = Net::FTP->new($host, Debug => 0, Timeout => 120); my $ftp = Net::FTP->new($host, Debug => 0, Timeout => 20);
if (!$ftp) { if (!$ftp) {
return (3, "Cannot connect to $host"); return (3, "Cannot connect to $host");
} }
@ -167,7 +171,8 @@ sub check_ftp_url($$$$)
else { else {
my $rEntries; my $rEntries;
if ($path ne "") { if ($path ne "") {
#print "Path = $path\n";
#print $fe "Path = $path\n";
#if (!$ftp->cwd($path)) { #if (!$ftp->cwd($path)) {
# $message = $ftp->message; # $message = $ftp->message;
# $res = 3; # $res = 3;
@ -185,13 +190,15 @@ sub check_ftp_url($$$$)
my $found = 0; my $found = 0;
my $found2 = 0; my $found2 = 0;
for my $f (@{$rEntries}) { for my $f (@{$rEntries}) {
#print "Entry: $path $f\n";
#print $fe "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;
} }
elsif ($res1 == 2) { elsif ($res1 == 2) {
# found, but not accessible # found, but not accessible
$found2 = 1; $found2 = 1;
$message = "Permission denied for '$file'"; $message = "Permission denied for '$file'";
@ -206,12 +213,12 @@ sub check_ftp_url($$$$)
} }
} }
$ftp->quit; $ftp->quit;
#print "returning ($res,$message)\n";
#print $fe "returning ($res,$message)\n";
return ($res, $message); return ($res, $message);
} }
sub check_unknown_url($$$$) sub check_unknown_url($$$$) {
{
use LWP::Simple; use LWP::Simple;
my ($protocol, $host, $path, $file) = @_; my ($protocol, $host, $path, $file) = @_;
@ -227,16 +234,18 @@ sub check_unknown_url($$$$)
} }
} }
if (defined($file)) { if (defined($file)) {
#print "Trying $url$file\n";
#print $fe "Trying $url$file\n";
$res = head("$url/$file"); $res = head("$url/$file");
if (!$res) { if (!$res) {
# try to check for directory '/'; # try to check for directory '/';
#print "Trying $url$file/\n"; #print $fe "Trying $url$file/\n";
$res = head("$url/$file/"); $res = head("$url/$file/");
} }
} }
else { else {
#print "Trying $url\n"; #print $fe "Trying $url\n";
$res = head($url); $res = head($url);
} }
return (!$res); return (!$res);
@ -244,9 +253,10 @@ sub check_unknown_url($$$$)
# #
# Main entry # Main entry
sub check_url($$) sub check_url($$$$) {
{ my ($url, $use_curl, $fex, $fsx) = @_;
my($url,$use_curl) = @_; $fe = $fex;
$fs = $fsx;
my $file = undef; my $file = undef;
my ($protocol, $host, $path); my ($protocol, $host, $path);
@ -261,6 +271,7 @@ sub check_url($$)
if ($path =~ s/\/([^\/]+)$//) { if ($path =~ s/\/([^\/]+)$//) {
$file = $1; $file = $1;
if ($file =~ / /) { if ($file =~ / /) {
# Filename contains ' ', maybe invalid. Don't check # Filename contains ' ', maybe invalid. Don't check
$file = undef; $file = undef;
} }
@ -268,7 +279,7 @@ sub check_url($$)
} }
} }
else { else {
print " Invalid url '$url'"; print $fe " Invalid url '$url'";
return 2; return 2;
} }
if ($protocol =~ /^https?$/) { if ($protocol =~ /^https?$/) {
@ -286,7 +297,7 @@ sub check_url($$)
} }
else { else {
# it never should reach this point # it never should reach this point
print " What protocol is '$protocol'?"; print $fe " What protocol is '$protocol'?";
$res = check_unknown_url($protocol, $host, $path, $file); $res = check_unknown_url($protocol, $host, $path, $file);
return $res; return $res;
} }

145
development/checkurls/search_url.pl
View File

@ -38,20 +38,31 @@ BEGIN {
unshift(@INC, "$p"); unshift(@INC, "$p");
} }
use warnings;
use Cwd qw(abs_path);
use CheckURL; use CheckURL;
use Try::Tiny; use Try::Tiny;
use locale; use locale;
use POSIX qw(locale_h); use POSIX qw(locale_h);
use Readonly;
Readonly::Scalar my $NR_JOBS => 10;
setlocale(LC_CTYPE, ""); setlocale(LC_CTYPE, "");
setlocale(LC_MESSAGES, "en_US.UTF-8"); setlocale(LC_MESSAGES, "en_US.UTF-8");
use File::Temp qw/ tempfile tempdir /;
use File::Spec;
use Fcntl qw(:flock SEEK_END);
# Prototypes # Prototypes
sub printNotUsedURLS($\%); sub printNotUsedURLS($\%);
sub replaceSpecialChar($); sub replaceSpecialChar($);
sub readUrls($\%); sub readUrls($\%);
sub parse_file($ ); sub parse_file($ );
sub handle_url($$$ ); sub handle_url($$$ );
sub printx($$$$);
sub getnrjobs($$$);
########## ##########
my %URLS = (); my %URLS = ();
@ -67,6 +78,7 @@ for my $arg (@ARGV) {
die("Bad argument \"$arg\"") if ($arg !~ /=/); die("Bad argument \"$arg\"") if ($arg !~ /=/);
my ($type, $val) = split("=", $arg); my ($type, $val) = split("=", $arg);
if ($type eq "filesToScan") { if ($type eq "filesToScan") {
#The file should be a list of files to search in #The file should be a list of files to search in
if (open(FLIST, $val)) { if (open(FLIST, $val)) {
while (my $l = <FLIST>) { while (my $l = <FLIST>) {
@ -103,6 +115,8 @@ for my $arg (@ARGV) {
} }
my @urls = sort keys %URLS, keys %extraURLS; my @urls = sort keys %URLS, keys %extraURLS;
my @testvals = ();
# Tests # Tests
#my @urls = ("ftp://ftp.edpsciences.org/pub/aa/readme.html", "ftp://ftp.springer.de/pub/tex/latex/compsc/proc/author"); #my @urls = ("ftp://ftp.edpsciences.org/pub/aa/readme.html", "ftp://ftp.springer.de/pub/tex/latex/compsc/proc/author");
my $errorcount = 0; my $errorcount = 0;
@ -128,12 +142,65 @@ for my $u (@urls) {
} }
next if ($checkSelectedOnly && !defined($selectedURLS{$u})); next if ($checkSelectedOnly && !defined($selectedURLS{$u}));
$URLScount++; $URLScount++;
print "Checking '$u': "; push(@testvals, {u => $u, use_curl => $use_curl,});
}
# Ready to go multitasking
my ($vol, $dir, $file) = File::Spec->splitpath($summaryFile);
my $tempdir = tempdir("$dir/CounterXXXXXXX", CLEANUP => 1);
my $countfile = "$tempdir/counter";
my $counter = 0;
if (open(my $FO, '>', $countfile)) {
print {$FO} $counter;
close($FO);
}
else {
unlink($countfile);
die("Could not write to $countfile");
}
print "Using tempdir \"" . abs_path($tempdir) . "\"\n";
my @wait = ();
for (my $i = 0; $i < $NR_JOBS; $i++) { # Number of subprocesses
my $pid = fork();
if ($pid == 0) {
# I am child
open(my $fe, '>:encoding(UTF-8)', "$tempdir/xxxError$i");
open(my $fs, '>:encoding(UTF-8)', "$tempdir/xxxSum$i");
while (1) {
open(my $fh, '+<', $countfile) or die("cannot open $countfile");
flock($fh, LOCK_EX) or die "$i: Cannot lock $countfile - $!\n";
my $l = <$fh>; # get actual count number
if (!defined($testvals[$l])) {
close($fs);
print $fe "NumberOfErrors $errorcount\n";
close($fe);
exit(0);
}
my $diff = getnrjobs(scalar @testvals, $l, $NR_JOBS);
if ($diff < 1) {
$diff = 1;
}
my $next = $l + $diff;
seek($fh, 0, 0);
truncate($fh, 0);
print $fh $next;
close($fh);
for (my $i = 0; $i < $diff; $i++) {
my $entryidx = $l + $i;
my $rentry = $testvals[$entryidx];
next if (!defined($rentry));
my $u = $rentry->{u};
my $use_curl = $rentry->{use_curl};
print $fe "Checking($entryidx) '$u': ";
my ($res, $prnt, $outSum); my ($res, $prnt, $outSum);
try { try {
$res = check_url($u, $use_curl); $res = check_url($u, $use_curl, $fe, $fs);
if ($res) { if ($res) {
print "Failed\n"; print $fe "Failed\n";
$prnt = ""; $prnt = "";
$outSum = 1; $outSum = 1;
} }
@ -147,7 +214,7 @@ for my $u (@urls) {
$outSum = 1; $outSum = 1;
$res = 700; $res = 700;
}; };
printx("$prnt", $outSum); printx("$prnt", $outSum, $fe, $fs);
my $printSourceFiles = 0; my $printSourceFiles = 0;
my $err_txt = "Error url:"; my $err_txt = "Error url:";
@ -159,13 +226,13 @@ for my $u (@urls) {
} }
$res = !$res if (defined($revertedURLS{$u})); $res = !$res if (defined($revertedURLS{$u}));
if ($res || $checkSelectedOnly) { if ($res || $checkSelectedOnly) {
printx("$err_txt \"$u\"\n", $outSum); printx("$err_txt \"$u\"\n", $outSum, $fe, $fs);
} }
if ($printSourceFiles) { if ($printSourceFiles) {
if (defined($URLS{$u})) { if (defined($URLS{$u})) {
for my $f (sort keys %{$URLS{$u}}) { for my $f (sort keys %{$URLS{$u}}) {
my $lines = ":" . join(',', @{$URLS{$u}->{$f}}); my $lines = ":" . join(',', @{$URLS{$u}->{$f}});
printx(" $f$lines\n", $outSum); printx(" $f$lines\n", $outSum, $fe, $fs);
} }
} }
if ($res) { if ($res) {
@ -173,6 +240,33 @@ for my $u (@urls) {
} }
} }
} }
}
}
$wait[$i] = $pid;
}
for (my $i = 0; $i < $NR_JOBS; $i++) {
my $p = $wait[$i];
if ($p > 0) {
waitpid($p, 0);
open(my $fe, '<', "$tempdir/xxxError$i");
while (my $l = <$fe>) {
if ($l =~ /^NumberOfErrors\s(\d+)/) {
$errorcount += $1;
}
else {
print $l;
}
}
close($fe);
open(my $fs, '<', "$tempdir/xxxSum$i");
while (my $l = <$fs>) {
print SFO $l;
}
close($fs);
}
}
unlink($countfile);
if (%URLS) { if (%URLS) {
printNotUsedURLS("Ignored", %ignoredURLS); printNotUsedURLS("Ignored", %ignoredURLS);
@ -187,17 +281,15 @@ if (defined($summaryFile)) {
exit($errorcount); exit($errorcount);
############################################################################### ###############################################################################
sub printx($$) sub printx($$$$) {
{ my ($txt, $outSum, $fe, $fs) = @_;
my ($txt, $outSum) = @_; print $fe "$txt";
print "$txt";
if ($outSum && defined($summaryFile)) { if ($outSum && defined($summaryFile)) {
print SFO "$txt"; print $fs "$txt";
} }
} }
sub printNotUsedURLS($\%) sub printNotUsedURLS($\%) {
{
my ($txt, $rURLS) = @_; my ($txt, $rURLS) = @_;
my @msg = (); my @msg = ();
for my $u (sort keys %{$rURLS}) { for my $u (sort keys %{$rURLS}) {
@ -215,15 +307,13 @@ sub printNotUsedURLS($\%)
} }
} }
sub replaceSpecialChar($) sub replaceSpecialChar($) {
{
my ($l) = @_; my ($l) = @_;
$l =~ s/\\SpecialChar(NoPassThru)?\s*(TeX|LaTeX|LyX)[\s]?/\2/; $l =~ s/\\SpecialChar(NoPassThru)?\s*(TeX|LaTeX|LyX)[\s]?/\2/;
return ($l); return ($l);
} }
sub readUrls($\%) sub readUrls($\%) {
{
my ($file, $rUrls) = @_; my ($file, $rUrls) = @_;
die("Could not read file $file") if (!open(ULIST, $file)); die("Could not read file $file") if (!open(ULIST, $file));
@ -245,8 +335,7 @@ sub readUrls($\%)
close(ULIST); close(ULIST);
} }
sub parse_file($) sub parse_file($) {
{
my ($f) = @_; my ($f) = @_;
my $status = "out"; # outside of URL/href my $status = "out"; # outside of URL/href
@ -257,6 +346,7 @@ sub parse_file($)
$line++; $line++;
$l =~ s/[\r\n]+$//; # Simulate chomp $l =~ s/[\r\n]+$//; # Simulate chomp
if ($status eq "out") { if ($status eq "out") {
# searching for "\begin_inset Flex URL" # searching for "\begin_inset Flex URL"
if ($l =~ /^\s*\\begin_inset\s+Flex\s+URL\s*$/) { if ($l =~ /^\s*\\begin_inset\s+Flex\s+URL\s*$/) {
$status = "inUrlInset"; $status = "inUrlInset";
@ -296,8 +386,7 @@ sub parse_file($)
} }
} }
sub handle_url($$$) sub handle_url($$$) {
{
my ($url, $f, $line) = @_; my ($url, $f, $line) = @_;
$url = &replaceSpecialChar($url); $url = &replaceSpecialChar($url);
@ -309,3 +398,17 @@ sub handle_url($$$)
} }
push(@{$URLS{$url}->{$f}}, $line); push(@{$URLS{$url}->{$f}}, $line);
} }
sub getnrjobs($$$) {
my ($tabsize, $actualidx, $nr_jobs) = @_;
my $maxidx = $tabsize - 1;
my $remaining = $maxidx - $actualidx;
if ($remaining <= 0) {
return (1);
}
if ($nr_jobs < 2) {
return ($remaining);
}
my $diff = 1 + int($remaining / (2 * $nr_jobs));
return $diff;
}