txurls - scripts - random scripts
  HTML git clone https://git.parazyd.org/scripts
   DIR Log
   DIR Files
   DIR Refs
       ---
       txurls (1960B)
       ---
            1 #!/usr/bin/perl
            2 
            3 use warnings;
            4 
            5 $hostchars = '[a-z0-9-._+]';
            6 $pathchars = '[a-z0-9-._+#=?&:;%/!,~]';
            7 
            8 sub scan($$$)
            9 {
           10         my ($file, $lineno, $line) = @_;
           11 
           12         chomp $line;
           13 
           14         while($line =~ s!
           15       ([a-z]+://)?
           16 
           17 # http://
           18 
           19       $hostchars+\.[a-z]+/
           20 
           21 # www.tim.google.com/ - the [a-z].com is the main anchor for the whole regex - incase http:// is omitted
           22 
           23       ($pathchars+/\?)*
           24 
           25 # check for the index.php? part
           26 
           27       ($pathchars+|\($pathchars+\))*
           28 
           29 # check for pathchars, or a set of nested parens
           30                                 !!xoi){ # allow space + comments, compile once, strcasecmp
           31 
           32                 my($p,$m,$e) = ($`,$&,$');
           33 
           34                 $e = '.' . $e if $m =~ s/\.$//;
           35 
           36                 if($opt{fname} && $file){
           37                         print "$col{red}$file$col{none}:";
           38                 }
           39 
           40                 if($opt{lineno}){
           41                         print "$col{green}$lineno$col{none}: ";
           42                 }elsif($opt{fname} && $file){
           43                         print ' ';
           44                 }
           45 
           46                 if($opt{hl}){
           47                         print "$p$col{brown}$m$col{none}$e\n";
           48                 }else{
           49                         print "$m\n";
           50                 }
           51         }
           52 }
           53 
           54 sub usage(){
           55         $printme =<<"!";
           56 Usage: $0 -[Chn] [FILES...]
           57  -h: highlight
           58  -c: force colour on (for pipes)
           59  -C: colour off (only makes sense with -h)
           60  -n: show line number
           61 !
           62         print STDERR $printme;
           63         exit 1;
           64 }
           65 
           66 
           67 %opt = (
           68         colour => 1,
           69         lineno => 0,
           70         fname  => 0,
           71         hl     => 0
           72 );
           73 %col = (
           74         brown => "\e[0;31m", # hl
           75         red   => "\e[0;35m", # fname
           76         green => "\e[0;32m", # lineno
           77         none  => "\e[0;0m"
           78 );
           79 
           80 for $arg (@ARGV){
           81         if($arg eq '-h'){
           82                 $opt{hl} = 1;
           83         }elsif($arg eq '-n'){
           84                 $opt{lineno} = 1;
           85         }elsif($arg eq '-C'){
           86                 $opt{colour} = 0;
           87         }elsif($arg eq '-c'){
           88                 usage() if $opt{colour} == 0;
           89                 $opt{colour} = 2; # force on
           90         }elsif($arg eq '--help'){
           91                 usage();
           92         }else{
           93                 push @files, $arg;
           94         }
           95 }
           96 
           97 usage() if $opt{hl} && !$opt{colour};
           98 
           99 $opt{fname} = 1 if $#files > 0 || $opt{lineno};
          100 if(!$opt{colour} || ($opt{colour} == 1 && !-t STDOUT)){
          101         $col{$_} = '' for keys %col;
          102 }
          103 
          104 $| = 1;
          105 
          106 if(@files){
          107         for my $f (@files){
          108                 my $n = 1;
          109                 open F, '<', $f or warn "$f: $!\n";
          110                 scan($f, $n++, $_) for <F>;
          111                 close F;
          112         }
          113 }else{
          114         scan(undef, $., $_) while <STDIN>;
          115 }