development/checkurls/search_url.pl

   1 #! /usr/bin/env perl
   2 # -*- mode: perl; -*-
   3 #
   4 # file search_url.pl
   5 # script to search for url's in lyxfiles
   6 # and testing their validity.
   7 #
   8 # Syntax: search_url.pl [(filesToScan|(ignored|reverted|extra|selected)URLS)={path_to_control]*
   9 # Param value is a path to a file containing list of xxx:
  10 # filesToScan={xxx = lyx-file-names to be scanned for}
  11 # ignoredURLS={xxx = urls that are discarded from test}
  12 # revertedURLS={xxx = urls that should fail, to test the test with invalid urls}
  13 # extraURLS={xxx = urls which should be also checked}
  14 #
  15 # This file is free software; you can redistribute it and/or
  16 # modify it under the terms of the GNU General Public
  17 # License as published by the Free Software Foundation; either
  18 # version 2 of the License, or (at your option) any later version.
  19 #
  20 # This software is distributed in the hope that it will be useful,
  21 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  23 # General Public License for more details.
  24 #
  25 # You should have received a copy of the GNU General Public
  26 # License along with this software; if not, write to the Free Software
  27 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  28 #
  29 # Copyright (c) 2013 Kornel Benko <kornel@lyx.org>
  30 #           (c) 2013 Scott Kostyshak <skotysh@lyx.org>
  31
  32 use strict;
  33
  34 BEGIN  {
  35   use File::Spec;
  36   my $p = File::Spec->rel2abs(__FILE__);
  37   $p =~ s/[\/\\]?[^\/\\]+$//;
  38   unshift(@INC, "$p");
  39 }
  40
  41 use CheckURL;
  42 use Try::Tiny;
  43 use locale;
  44 use POSIX qw(locale_h);
  45
  46 setlocale(LC_CTYPE, "");
  47 setlocale(LC_MESSAGES, "en_US.UTF-8");
  48
  49 # Prototypes
  50 sub printNotUsedURLS($\%);
  51 sub replaceSpecialChar($);
  52 sub readUrls($\%);
  53 sub parse_file($ );
  54 sub handle_url($$$ );
  55 ##########
  56
  57 my %URLS = ();
  58 my %ignoredURLS = ();
  59 my %revertedURLS = ();
  60 my %extraURLS = ();
  61 my %selectedURLS = ();
  62 my %knownToRegisterURLS = ();
  63 my $summaryFile = undef;
  64
  65 my $checkSelectedOnly = 0;
  66 for my $arg (@ARGV) {
  67   die("Bad argument \"$arg\"") if ($arg !~ /=/);
  68   my ($type,$val) = split("=", $arg);
  69   if ($type eq "filesToScan") {
  70     #The file should be a list of files to search in
  71     if (open(FLIST, $val)) {
  72       while (my $l = <FLIST>) {
  73         chomp($l);
  74         parse_file($l);
  75       }
  76       close(FLIST);
  77     }
  78   }
  79   elsif ($type eq "ignoredURLS") {
  80     readUrls($val, %ignoredURLS);
  81   }
  82   elsif ($type eq "revertedURLS") {
  83     readUrls($val, %revertedURLS);
  84   }
  85   elsif ($type eq "extraURLS") {
  86     readUrls($val, %extraURLS);
  87   }
  88   elsif ($type eq "selectedURLS") {
  89     $checkSelectedOnly = 1;
  90     readUrls($val, %selectedURLS);
  91   }
  92   elsif ($type eq "knownToRegisterURLS") {
  93     readUrls($val, %knownToRegisterURLS);
  94   }
  95   elsif ($type eq "summaryFile") {
  96     if (open(SFO, '>', "$val")) {
  97       $summaryFile = $val;
  98     }
  99   }
 100   else {
 101     die("Invalid argument \"$arg\"");
 102   }
 103 }
 104
 105 my @urls = sort keys %URLS, keys %extraURLS;
 106 # Tests
 107 #my @urls = ("ftp://ftp.edpsciences.org/pub/aa/readme.html", "ftp://ftp.springer.de/pub/tex/latex/compsc/proc/author");
 108 my $errorcount = 0;
 109
 110 my $URLScount = 0;
 111
 112 for my $u (@urls) {
 113   if (defined($ignoredURLS{$u})) {
 114     $ignoredURLS{$u}->{count} += 1;
 115     next;
 116   }
 117   my $use_curl = 0;
 118   if (defined($knownToRegisterURLS{$u})) {
 119     if ($knownToRegisterURLS{$u}->{use_curl}) {
 120       $use_curl = 1;
 121     }
 122     else {
 123       next;
 124     }
 125   }
 126   if (defined($selectedURLS{$u})) {
 127     ${selectedURLS}{$u}->{count} += 1;
 128   }
 129   next if ($checkSelectedOnly && ! defined($selectedURLS{$u}));
 130   $URLScount++;
 131   print "Checking '$u': ";
 132   my ($res, $prnt, $outSum);
 133   try {
 134     $res = check_url($u, $use_curl);
 135     if ($res) {
 136       print "Failed\n";
 137       $prnt = "";
 138       $outSum = 1;
 139     }
 140     else {
 141       $prnt = "OK\n";
 142       $outSum = 0;
 143     }
 144   }
 145   catch {
 146     $prnt = "Failed, caught error: $_\n";
 147     $outSum = 1;
 148     $res = 700;
 149   };
 150   printx("$prnt", $outSum);
 151   my $printSourceFiles = 0;
 152   my $err_txt = "Error url:";
 153
 154   if ($res || $checkSelectedOnly) {
 155     $printSourceFiles = 1;
 156   }
 157   if ($res && defined($revertedURLS{$u})) {
 158     $err_txt = "Failed url:";
 159   }
 160   $res = ! $res if (defined($revertedURLS{$u}));
 161   if ($res || $checkSelectedOnly) {
 162     printx("$err_txt \"$u\"\n", $outSum);
 163   }
 164   if ($printSourceFiles) {
 165     if (defined($URLS{$u})) {
 166       for my $f(sort keys %{$URLS{$u}}) {
 167         my $lines = ":" . join(',', @{$URLS{$u}->{$f}});
 168         printx("  $f$lines\n", $outSum);
 169       }
 170     }
 171     if ($res ) {
 172       $errorcount++;
 173     }
 174   }
 175 }
 176
 177 if (%URLS) {
 178   printNotUsedURLS("Ignored", %ignoredURLS);
 179   printNotUsedURLS("Selected", %selectedURLS);
 180   printNotUsedURLS("KnownInvalid", %extraURLS);
 181 }
 182
 183 print "\n$errorcount URL-tests failed out of $URLScount\n\n";
 184 if (defined($summaryFile)) {
 185   close(SFO);
 186 }
 187 exit($errorcount);
 188
 189 ###############################################################################
 190 sub printx($$)
 191 {
 192   my ($txt, $outSum) = @_;
 193   print "$txt";
 194   if ($outSum && defined($summaryFile)) {
 195     print SFO "$txt";
 196   }
 197 }
 198
 199 sub printNotUsedURLS($\%)
 200 {
 201   my ($txt, $rURLS) = @_;
 202   my @msg = ();
 203   for my $u ( sort keys %{$rURLS}) {
 204     if ($rURLS->{$u}->{count} < 2) {
 205       my @submsg = ();
 206       for my $f (sort keys %{$rURLS->{$u}}) {
 207         next if ($f eq "count");
 208         push(@submsg, "$f:" . $rURLS->{$u}->{$f});
 209       }
 210       push(@msg, "\n  $u\n    " . join("\n    ", @submsg) . "\n");
 211     }
 212   }
 213   if (@msg) {
 214     print "\n$txt URLs not found in sources: " . join(' ',@msg) . "\n";
 215   }
 216 }
 217
 218 sub replaceSpecialChar($)
 219 {
 220   my ($l) = @_;
 221   $l =~ s/\\SpecialChar(NoPassThru)?\s*(TeX|LaTeX|LyX)[\s]?/\2/;
 222   return($l);
 223 }
 224
 225 sub readUrls($\%)
 226 {
 227   my ($file, $rUrls) = @_;
 228
 229   die("Could not read file $file") if (! open(ULIST, $file));
 230   my $line = 0;
 231   while (my $l = <ULIST>) {
 232     $line++;
 233     $l =~ s/[\r\n]+$//;         # remove eol
 234     $l =~ s/\s*\#.*$//;         # remove comment
 235     $l = &replaceSpecialChar($l);
 236     next if ($l eq "");
 237     my $use_curl = 0;
 238     if ($l =~ s/^\s*UseCurl\s*//) {
 239       $use_curl = 1;
 240     }
 241     if (! defined($rUrls->{$l} )) {
 242       $rUrls->{$l} = {$file => $line, count => 1, use_curl => $use_curl};
 243     }
 244   }
 245   close(ULIST);
 246 }
 247
 248 sub parse_file($)
 249 {
 250   my($f) = @_;
 251   my $status = "out";           # outside of URL/href
 252
 253   return if ($f =~ /\/attic\//);
 254   if(open(FI, $f)) {
 255     my $line = 0;
 256     while(my $l = <FI>) {
 257       $line++;
 258       $l =~ s/[\r\n]+$//;       #  Simulate chomp
 259       if ($status eq "out") {
 260         # searching for "\begin_inset Flex URL"
 261         if($l =~ /^\s*\\begin_inset\s+Flex\s+URL\s*$/) {
 262           $status = "inUrlInset";
 263         }
 264         elsif ($l =~ /^\s*\\begin_inset\s+CommandInset\s+href\s*$/) {
 265           $status = "inHrefInset";
 266         }
 267         else {
 268           # Outside of url, check also
 269           if ($l =~ /"((ftp|http|https):\/\/[^ ]+)"/) {
 270             my $url = $1;
 271             handle_url($url, $f, "x$line");
 272           }
 273         }
 274       }
 275       else {
 276         if($l =~ /^\s*\\end_(layout|inset)\s*$/) {
 277           $status = "out";
 278         }
 279         elsif ($status eq "inUrlInset") {
 280           if ($l =~ /\s*([a-z]+:\/\/.+)\s*$/) {
 281             my $url = $1;
 282             $status = "out";
 283             handle_url($url, $f, "u$line");
 284           }
 285         }
 286         elsif ($status eq "inHrefInset") {
 287           if ($l =~ /^target\s+"([a-z]+:\/\/[^ ]+)"$/) {
 288             my $url = $1;
 289             $status = "out";
 290             handle_url($url, $f, "h$line");
 291           }
 292         }
 293       }
 294     }
 295     close(FI);
 296   }
 297 }
 298
 299 sub handle_url($$$)
 300 {
 301   my($url, $f, $line) = @_;
 302
 303   $url = &replaceSpecialChar($url);
 304   if(!defined($URLS{$url})) {
 305     $URLS{$url} = {};
 306   }
 307   if(!defined($URLS{$url}->{$f})) {
 308     $URLS{$url}->{$f} = [];
 309   }
 310   push(@{$URLS{$url}->{$f}}, $line);
 311 }