0: #!/usr/bin/perl -w
1: 
2: ######################################################################
3: #
4: #   Parse-href.pl      2001-05
5: #
6: #   Grab the content of all "href" attributes of the HTML "<a>" tag,
7: #   Insert a redirection URL in the "href" and then UrlEncode the Old 
8: #   Url to pass it in parameter.
9: # 
10: #   Greetings flys out to OeufMayo for his help.
11: #
12: #   Nicolas Crovatti  <ncrovatti@ifrance.com>
13: #   http://www.gencoding.com
14: #
15: ######################################################################
16: 
17: 
18: use strict;
19: use URI::Escape;
20: use warnings;
21: use CGI ':standard';
22: 
23: my @forminputs;
24: my $JavascriptLinks;
25: my %results;
26: my $name;
27: my $html;
28: my $OUTHTML;
29: my $INHTML;
30: my $dDate     = time();
31: my $RedirURL  = "http://127.0.0.1/rapport/rnews.php?dt=" . $dDate . "&url=";
32: my $File      = param("file");
33: 
34: {
35:   package myParser;
36:   use base qw(HTML::Parser);
37:     sub start
38:     {
39:       # We fill Scalars using predefined array "@_"
40:       ####################################################################
41:       my ($self, $tagname, $attr, $attrseq, $origtext) = @_;
42:       my $at;
43:       # For each <a> tag, we  grab the content of the "href" attribute, then we
44:       # uri_escape it with URI::Escape module, and we rebuild the integrality 
45:       # of the tag including our $RedirURL .
46:       ##########################################################################
47:       if ($tagname eq 'a'){
48:         #Here, if we reach a <a> tag,i don't want to parse '<a href="#">' 
49:         #links, we incremment the $LiensJavascript counter.
50:         ###################################################################
51:         if ($attr->{href} && $attr->{href} eq "#") {
52:           $JavascriptLinks++;
53:           print $origtext;
54:         } else {
55:             $attr->{href} =  $RedirURL . main::uri_escape($attr->{href}, "^A-Za-z0-9");
56:             print '<a';
57:             print qq' $_="$attr->{$_}"' foreach @{$attrseq};
58:             print ">";
59:         }
60:       } else {
61:         # If we don't find <a> tag, we print the original text
62:         ######################################################
63:         print $origtext;
64:       }
65:     }
66:     sub end {
67:       my ($self, undef, $origtext) = @_;
68:       print $origtext;
69:     }
70:     sub text
71:     {
72:       my ($self, $origtext) = @_;
73:       print $origtext;
74:     }
75: }
76: 
77: # Getting all params
78: ####################
79: @forminputs=param();
80: foreach $name (@forminputs){
81:   $results{$name}=param($name);
82: }
83: 
84: # Opening the HTML file in read mode only
85: ############################################
86: open(INHTML, "<$File") || die <<"EOT_";
87:  -[Erreur prevue]---------------------
88:  Usage :
89:  perl parse.pl file=file_name.htm
90:  $!
91:  -------------------------------------
92: EOT_
93: 
94: 
95: open(OUTHTML, ">News-ok.htm") || die <<"EOT_";
96:  -[Erreur]----------------------------
97:  Cannot open file:
98:  $!
99:  -------------------------------------
100: EOT_
101: 
102: # $html is filled with all the content of the input file
103: ########################################################
104: while ($_=<INHTML>){$html .= $_;}
105: close INHTML;
106: 
107: 
108: # Initialising the Parser
109: #########################
110: my $p = myParser->new();
111: 
112: # Parsing $html
113: ###############
114: select OUTHTML;
115: $p->parse($html);
116: select STDOUT;
117: 
118: close OUTHTML;
119: 
120: print "
121:  -[Result ok]---------------
122: 
123:  Everything goes Ok!
124:  
125:  not modified links : $JavascriptLinks
126:  
127:  -[eot]-----------------------------
128: ";
129: exit;