Cmake url tests: try to check also some modified urls

If the url contains 'ctan', try to determine the correct url depending
of the components to deside if using 'https://www.ctan.org' or rather
https://mirrors.ctan.org.
Without 'ctan' try to check https:// instead of ftp:// or http://
This commit is contained in:
Kornel Benko 2024-10-30 11:08:31 +01:00
parent 110e654b67
commit 7d8c1fcf64
3 changed files with 85 additions and 19 deletions

View File

@ -19,7 +19,7 @@ our (@EXPORT, @ISA);
BEGIN { BEGIN {
use Exporter (); use Exporter ();
@ISA = qw(Exporter); @ISA = qw(Exporter);
@EXPORT = qw(check_url); @EXPORT = qw(check_url constructExtraTestUrl);
} }
# Prototypes # Prototypes
@ -260,6 +260,7 @@ sub check_unknown_url($$$$) {
# Main entry # Main entry
sub check_url($$$$) { sub check_url($$$$) {
my ($url, $use_curl, $fex, $fsx) = @_; my ($url, $use_curl, $fex, $fsx) = @_;
$url =~ s/%20/ /g;
$fe = $fex; $fe = $fex;
$fs = $fsx; $fs = $fsx;
my $file = undef; my $file = undef;
@ -308,4 +309,59 @@ sub check_url($$$$) {
} }
} }
sub constructExtraTestUrl($) {
my ($url) = @_;
my $urlok = $url;
my $protokol;
if ($urlok =~ s/^(ftp|https?):\/\///) {
$protokol = $1;
if ($protokol eq 'http') {
$protokol = 'https';
}
if (($protokol eq 'ftp') && ($urlok =~ /ctan/)) {
$protokol = 'https';
}
}
$urlok =~ s/^([^\/]+)//;
my $server = $1;
$urlok =~ s/^\///;
if ($server =~ /ctan/) {
$urlok =~ s/\/\/+/\//g;
$urlok =~ s/^ctan\///;
if ($urlok =~ /[\w][.](pdf|html|dvi)$/) {
if ($urlok =~ s/^(tex-archive|CTAN)\///) {
$server = 'mirrors.ctan.org';
}
elsif ($urlok =~ /(pgf)\//) {
$server = 'www.ctan.org';
}
}
else {
if ($urlok =~ s/\/$//) {
$server = 'www.cpan.org';
if ($urlok ne '') {
if ("$urlok/" =~
/^(biblio|bibliography|digest|documentation|dviware|fonts|graphics|help|indexing|info|install|languages?|macros|obsolete|support|systems|tds|usergrps|web)\//
)
{
$urlok = 'tex-archive/' . $urlok;
}
if ("$urlok/" !~ /^(pkg|topic|tex-archive|author)\//) {
die("");
}
}
}
}
}
my $url2;
if ($urlok eq '') {
$url2 = "$protokol://$server";
}
else {
$url2 = "$protokol://$server/$urlok";
}
return($url2);
}
1; 1;

View File

@ -11,7 +11,6 @@ https://texample.net/media/tikz/examples/TEX/free-body-diagrams.tex
# Urls probably exist, but to check # Urls probably exist, but to check
# we need to register and login first # we need to register and login first
http://www.issn.org/en/node/344
http://www.springer.de/author/tex/help-journals.html http://www.springer.de/author/tex/help-journals.html
http://www.wkap.nl/jrnllist.htm/JRNLHOME http://www.wkap.nl/jrnllist.htm/JRNLHOME
http://www.wkap.nl/kaphtml.htm/STYLEFILES http://www.wkap.nl/kaphtml.htm/STYLEFILES

View File

@ -30,6 +30,7 @@
# (c) 2013 Scott Kostyshak <skotysh@lyx.org> # (c) 2013 Scott Kostyshak <skotysh@lyx.org>
use strict; use strict;
use warnings;
BEGIN { BEGIN {
use File::Spec; use File::Spec;
@ -38,7 +39,6 @@ BEGIN {
unshift(@INC, "$p"); unshift(@INC, "$p");
} }
use warnings;
use Cwd qw(abs_path); use Cwd qw(abs_path);
use CheckURL; use CheckURL;
use Try::Tiny; use Try::Tiny;
@ -46,6 +46,8 @@ use locale;
use POSIX qw(locale_h); use POSIX qw(locale_h);
use Readonly; use Readonly;
binmode(STDOUT, ":encoding(UTF-8)");
Readonly::Scalar my $NR_JOBS => 10; Readonly::Scalar my $NR_JOBS => 10;
setlocale(LC_CTYPE, ""); setlocale(LC_CTYPE, "");
@ -71,6 +73,7 @@ my %revertedURLS = ();
my %extraURLS = (); my %extraURLS = ();
my %selectedURLS = (); my %selectedURLS = ();
my %knownToRegisterURLS = (); my %knownToRegisterURLS = ();
my %extraTestURLS = ();
my $summaryFile = undef; my $summaryFile = undef;
my $checkSelectedOnly = 0; my $checkSelectedOnly = 0;
@ -80,7 +83,7 @@ for my $arg (@ARGV) {
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>) {
chomp($l); chomp($l);
parse_file($l); parse_file($l);
@ -105,7 +108,7 @@ for my $arg (@ARGV) {
readUrls($val, %knownToRegisterURLS); readUrls($val, %knownToRegisterURLS);
} }
elsif ($type eq "summaryFile") { elsif ($type eq "summaryFile") {
if (open(SFO, '>', "$val")) { if (open(SFO, '>:encoding(UTF8)', "$val")) {
$summaryFile = $val; $summaryFile = $val;
} }
} }
@ -143,10 +146,15 @@ for my $u (@urls) {
next if ($checkSelectedOnly && !defined($selectedURLS{$u})); next if ($checkSelectedOnly && !defined($selectedURLS{$u}));
$URLScount++; $URLScount++;
push(@testvals, {u => $u, use_curl => $use_curl,}); push(@testvals, {u => $u, use_curl => $use_curl,});
if ($u =~ s/^http:/https:/) { my $uorig = $u;
if (!defined($selectedURLS{$u})) { # check also the corresponging 'https:' url $u = constructExtraTestUrl($uorig);
push(@testvals, {u => $u, use_curl => $use_curl, extra => 1,}); if ($u ne $uorig) {
$URLScount++; if (!defined($selectedURLS{$u})) {
if (!defined($extraTestURLS{$u})) {
$extraTestURLS{$u} = 1; # omit multiple tests
push(@testvals, {u => $u, use_curl => $use_curl, extra => 1});
$URLScount++;
}
} }
} }
} }
@ -206,7 +214,7 @@ for (my $i = 0; $i < $NR_JOBS; $i++) { # Number of subprocesses
my $use_curl = $rentry->{use_curl}; my $use_curl = $rentry->{use_curl};
my $extra = defined($rentry->{extra}); my $extra = defined($rentry->{extra});
print $fe "Checking($entryidx-$subprocess) '$u': "; print $fe "Checking($entryidx-$subprocess) '$u': time=" . time() . ' ';
my ($res, $prnt, $outSum); my ($res, $prnt, $outSum);
try { try {
$res = check_url($u, $use_curl, $fe, $fs); $res = check_url($u, $use_curl, $fe, $fs);
@ -248,6 +256,7 @@ for (my $i = 0; $i < $NR_JOBS; $i++) { # Number of subprocesses
else { else {
my $succes; my $succes;
if ($extra) { if ($extra) {
# This url is created
$succes = "Extra_OK url:"; $succes = "Extra_OK url:";
} }
else { else {
@ -274,7 +283,7 @@ for (my $i = 0; $i < $NR_JOBS; $i++) { # Number of subprocesses
sub readsublog($) { sub readsublog($) {
my ($i) = @_; my ($i) = @_;
open(my $fe, '<', "$tempdir/xxxError$i"); open(my $fe, '<:encoding(UTF-8)', "$tempdir/xxxError$i");
while (my $l = <$fe>) { while (my $l = <$fe>) {
if ($l =~ /^NumberOfErrors\s(\d+)/) { if ($l =~ /^NumberOfErrors\s(\d+)/) {
$errorcount += $1; $errorcount += $1;
@ -345,29 +354,32 @@ sub printNotUsedURLS($\%) {
} }
} }
if (@msg) { if (@msg) {
print "\n$txt URLs not found in sources: " . join(' ', @msg) . "\n"; print "\n$txt URLs: " . join(' ', @msg) . "\n";
} }
} }
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/;
$l =~ s/ /%20/g;
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, '<:encoding(UTF-8)', $file));
print "Read urls from $file\n";
my $line = 0; my $line = 0;
while (my $l = <ULIST>) { while (my $l = <ULIST>) {
$line++; $line++;
$l =~ s/[\r\n]+$//; # remove eol chomp($l); # remove eol
$l =~ s/\s*\#.*$//; # remove comment $l =~ s/^\s+//;
$l = &replaceSpecialChar($l); next if ($l =~ /^\#/); # discard comment lines
next if ($l eq ""); next if ($l eq "");
$l = &replaceSpecialChar($l);
my $use_curl = 0; my $use_curl = 0;
if ($l =~ s/^\s*UseCurl\s*//) { if ($l =~ s/^UseCurl\s*//) {
$use_curl = 1; $use_curl = 1;
} }
if (!defined($rUrls->{$l})) { if (!defined($rUrls->{$l})) {
@ -382,13 +394,12 @@ sub parse_file($) {
my $status = "out"; # outside of URL/href my $status = "out"; # outside of URL/href
#return if ($f =~ /\/attic\//); #return if ($f =~ /\/attic\//);
if (open(FI, $f)) { if (open(FI, '<:encoding(UTF-8)', $f)) {
my $line = 0; my $line = 0;
while (my $l = <FI>) { while (my $l = <FI>) {
$line++; $line++;
chomp($l); chomp($l);
# $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"