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