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