123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117 |
- #!/usr/bin/perl
- use warnings;
- $hostchars = '[a-z0-9-._+]';
- $pathchars = '[a-z0-9-._+#=?&:;%/!,~]';
- sub scan($$$)
- {
- my ($file, $lineno, $line) = @_;
- chomp $line;
- while($line =~ s!
- ([a-z]+://)?
- # http://
- $hostchars+\.[a-z]+
- # www.tim.google.com - the [a-z].com is the main anchor for the whole regex - incase http:// is omitted
- # note no trailing slash
- ($pathchars+/\?)*
- # check for the index.php? part
- ($pathchars+|\($pathchars+\))*
- # check for pathchars, or a set of nested parens
- !!xoi){ # allow space + comments, compile once, strcasecmp
- my($p,$m,$e) = ($`,$&,$');
- $e = '.' . $e if $m =~ s/\.$//;
- if($opt{fname} && $file){
- print "$col{red}$file$col{none}:";
- }
- if($opt{lineno}){
- print "$col{green}$lineno$col{none}: ";
- }elsif($opt{fname} && $file){
- print ' ';
- }
- if($opt{hl}){
- print "$p$col{brown}$m$col{none}$e\n";
- }else{
- print "$m\n";
- }
- }
- }
- sub usage(){
- $printme =<<"!";
- Usage: $0 -[Chn] [FILES...]
- -h: highlight
- -c: force colour on (for pipes)
- -C: colour off (only makes sense with -h)
- -n: show line number
- !
- print STDERR $printme;
- exit 1;
- }
- %opt = (
- colour => 1,
- lineno => 0,
- fname => 0,
- hl => 0
- );
- %col = (
- brown => "\e[0;31m", # hl
- red => "\e[0;35m", # fname
- green => "\e[0;32m", # lineno
- none => "\e[0;0m"
- );
- for $arg (@ARGV){
- if($arg eq '-h'){
- $opt{hl} = 1;
- }elsif($arg eq '-n'){
- $opt{lineno} = 1;
- }elsif($arg eq '-C'){
- $opt{colour} = 0;
- }elsif($arg eq '-c'){
- usage() if $opt{colour} == 0;
- $opt{colour} = 2; # force on
- }elsif($arg eq '--help'){
- usage();
- }else{
- push @files, $arg;
- }
- }
- usage() if $opt{hl} && !$opt{colour};
- $opt{fname} = 1 if $#files > 0 || $opt{lineno};
- if(!$opt{colour} || ($opt{colour} == 1 && !-t STDOUT)){
- $col{$_} = '' for keys %col;
- }
- $| = 1;
- if(@files){
- for my $f (@files){
- my $n = 1;
- open F, '<', $f or warn "$f: $!\n";
- scan($f, $n++, $_) for <F>;
- close F;
- }
- }else{
- scan(undef, $., $_) while <STDIN>;
- }
|