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 $summaryFile = undef;
  63
  64 my $checkSelectedOnly = 0;
  65 for my $arg (@ARGV) {
  66   die("Bad argument \"$arg\"") if ($arg !~ /=/);
  67   my ($type,$val) = split("=", $arg);
  68   if ($type eq "filesToScan") {
  69     #The file should be a list of files to search in
  70     if (open(FLIST, $val)) {
  71       while (my $l = <FLIST>) {
  72         chomp($l);
  73         parse_file($l);
  74       }
  75       close(FLIST);
  76     }
  77   }
  78   elsif ($type eq "ignoredURLS") {
  79     readUrls($val, %ignoredURLS);
  80   }
  81   elsif ($type eq "revertedURLS") {
  82     readUrls($val, %revertedURLS);
  83   }
  84   elsif ($type eq "extraURLS") {
  85     readUrls($val,  %extraURLS);
  86   }
  87   elsif ($type eq "selectedURLS") {
  88     $checkSelectedOnly = 1;
  89     readUrls($val,  %selectedURLS);
  90   }
  91   elsif ($type eq "summaryFile") {
  92     if (open(SFO, '>', "$val")) {
  93       $summaryFile = $val;
  94     }
  95   }
  96   else {
  97     die("Invalid argument \"$arg\"");
  98   }
  99 }
 100
 101 my @urls = sort keys %URLS, keys %extraURLS;
 102 my $errorcount = 0;
 103
 104 my $URLScount = 0;
 105
 106 for my $u (@urls) {
 107   if (defined($selectedURLS{$u})) {
 108     ${selectedURLS}{$u}->{count} += 1;
 109   }
 110   if (defined($ignoredURLS{$u})) {
 111     $ignoredURLS{$u}->{count} += 1;
 112     next;
 113   }
 114   next if ($checkSelectedOnly && ! defined($selectedURLS{$u}));
 115   $URLScount++;
 116   print "Checking '$u': ";
 117   my ($res, $prnt, $outSum);
 118   try {
 119     $res = check_url($u);
 120     if ($res) {
 121       print "Failed\n";
 122       $prnt = "";
 123       $outSum = 1;
 124     }
 125     else {
 126       $prnt = "OK\n";
 127       $outSum = 0;
 128     }
 129   }
 130   catch {
 131     $prnt = "Failed, caught error: $_\n";
 132     $outSum = 1;
 133     $res = 700;
 134   };
 135   printx("$prnt", $outSum);
 136   my $printSourceFiles = 0;
 137   my $err_txt = "Error url:";
 138
 139   if ($res || $checkSelectedOnly) {
 140     $printSourceFiles = 1;
 141   }
 142   if ($res && defined($revertedURLS{$u})) {
 143     $err_txt = "Failed url:";
 144   }
 145   $res = ! $res if (defined($revertedURLS{$u}));
 146   if ($res || $checkSelectedOnly) {
 147     printx("$err_txt \"$u\"\n", $outSum);
 148   }
 149   if ($printSourceFiles) {
 150     if (defined($URLS{$u})) {
 151       for my $f(sort keys %{$URLS{$u}}) {
 152         my $lines = ":" . join(',', @{$URLS{$u}->{$f}});
 153         printx("  $f$lines\n", $outSum);
 154       }
 155     }
 156     if ($res ) {
 157       $errorcount++;
 158     }
 159   }
 160 }
 161
 162 if (%URLS) {
 163   printNotUsedURLS("Ignored", %ignoredURLS);
 164   printNotUsedURLS("Selected", %selectedURLS);
 165   printNotUsedURLS("KnownInvalid", %extraURLS);
 166 }
 167
 168 print "\n$errorcount URL-tests failed out of $URLScount\n\n";
 169 if (defined($summaryFile)) {
 170   close(SFO);
 171 }
 172 exit($errorcount);
 173
 174 ###############################################################################
 175 sub printx($$)
 176 {
 177   my ($txt, $outSum) = @_;
 178   print "$txt";
 179   if ($outSum && defined($summaryFile)) {
 180     print SFO "$txt";
 181   }
 182 }
 183
 184 sub printNotUsedURLS($\%)
 185 {
 186   my ($txt, $rURLS) = @_;
 187   my @msg = ();
 188   for my $u ( sort keys %{$rURLS}) {
 189     if ($rURLS->{$u}->{count} < 2) {
 190       my @submsg = ();
 191       for my $f (sort keys %{$rURLS->{$u}}) {
 192         next if ($f eq "count");
 193         push(@submsg, "$f:" . $rURLS->{$u}->{$f});
 194       }
 195       push(@msg, "\n  $u\n    " . join("\n    ", @submsg) . "\n");
 196     }
 197   }
 198   if (@msg) {
 199     print "\n$txt URLs not found in sources: " . join(' ',@msg) . "\n";
 200   }
 201 }
 202
 203 sub replaceSpecialChar($)
 204 {
 205   my ($l) = @_;
 206   $l =~ s/\\SpecialChar(NoPassThru)?\s*(TeX|LaTeX|LyX)[\s]?/\2/;
 207   return($l);
 208 }
 209
 210 sub readUrls($\%)
 211 {
 212   my ($file, $rUrls) = @_;
 213
 214   die("Could not read file $file") if (! open(ULIST, $file));
 215   my $line = 0;
 216   while (my $l = <ULIST>) {
 217     $line++;
 218     $l =~ s/[\r\n]+$//;         # remove eol
 219     $l =~ s/\s*\#.*$//;         # remove comment
 220     $l = &replaceSpecialChar($l);
 221     next if ($l eq "");
 222     if (! defined($rUrls->{$l} )) {
 223       $rUrls->{$l} = {$file => $line, count => 1};
 224     }
 225   }
 226   close(ULIST);
 227 }
 228
 229 sub parse_file($)
 230 {
 231   my($f) = @_;
 232   my $status = "out";           # outside of URL/href
 233
 234   return if ($f =~ /\/attic\//);
 235   if(open(FI, $f)) {
 236     my $line = 0;
 237     while(my $l = <FI>) {
 238       $line++;
 239       $l =~ s/[\r\n]+$//;       #  Simulate chomp
 240       if ($status eq "out") {
 241         # searching for "\begin_inset Flex URL"
 242         if($l =~ /^\s*\\begin_inset\s+Flex\s+URL\s*$/) {
 243           $status = "inUrlInset";
 244         }
 245         elsif ($l =~ /^\s*\\begin_inset\s+CommandInset\s+href\s*$/) {
 246           $status = "inHrefInset";
 247         }
 248         else {
 249           # Outside of url, check also
 250           if ($l =~ /"((ftp|http|https):\/\/[^ ]+)"/) {
 251             my $url = $1;
 252             handle_url($url, $f, "x$line");
 253           }
 254         }
 255       }
 256       else {
 257         if($l =~ /^\s*\\end_(layout|inset)\s*$/) {
 258           $status = "out";
 259         }
 260         elsif ($status eq "inUrlInset") {
 261           if ($l =~ /\s*([a-z]+:\/\/.+)\s*$/) {
 262             my $url = $1;
 263             $status = "out";
 264             handle_url($url, $f, "u$line");
 265           }
 266         }
 267         elsif ($status eq "inHrefInset") {
 268           if ($l =~ /^target\s+"([a-z]+:\/\/[^ ]+)"$/) {
 269             my $url = $1;
 270             $status = "out";
 271             handle_url($url, $f, "h$line");
 272           }
 273         }
 274       }
 275     }
 276     close(FI);
 277   }
 278 }
 279
 280 sub handle_url($$$)
 281 {
 282   my($url, $f, $line) = @_;
 283
 284   $url = &replaceSpecialChar($url);
 285   if(!defined($URLS{$url})) {
 286     $URLS{$url} = {};
 287   }
 288   if(!defined($URLS{$url}->{$f})) {
 289     $URLS{$url}->{$f} = [];
 290   }
 291   push(@{$URLS{$url}->{$f}}, $line);
 292 }