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 }