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