perl/contrib/formfind

   1 #!/usr/bin/env perl
   2 #
   3 # formfind.pl
   4 #
   5 # This script gets a HTML page on stdin and presents form information on
   6 # stdout.
   7 #
   8 # Author: Daniel Stenberg <daniel@haxx.se>
   9 # Version: 0.2 Nov 18, 2002
  10 #
  11 # HISTORY
  12 #
  13 # 0.1 - Nov 12 1998 - Created now!
  14 # 0.2 - Nov 18 2002 - Enhanced. Removed URL support, use only stdin.
  15 #
  16
  17 $in="";
  18
  19 if($ARGV[0] eq "-h") {
  20     print  "Usage: $0 < HTML\n";
  21     exit;
  22 }
  23
  24 sub namevalue {
  25     my ($tag)=@_;
  26     my $name=$tag;
  27     if($name =~ /name *=/i) {
  28         if($name =~ /name *= *([^\"\']([^ \">]*))/i) {
  29             $name = $1;
  30         }
  31         elsif($name =~ /name *= *(\"|\')([^\"\']*)(\"|\')/i) {
  32             $name=$2;
  33         }
  34         else {
  35             # there is a tag but we didn't find the contents
  36             $name="[weird]";
  37         }
  38
  39     }
  40     else {
  41         # no name given
  42         $name="";
  43     }
  44     # get value tag
  45     my $value= $tag;
  46     if($value =~ /[^\.a-zA-Z0-9]value *=/i) {
  47         if($value =~ /[^\.a-zA-Z0-9]value *= *([^\"\']([^ \">]*))/i) {
  48             $value = $1;
  49         }
  50         elsif($value =~ /[^\.a-zA-Z0-9]value *= *(\"|\')([^\"\']*)(\"|\')/i) {
  51             $value=$2;
  52         }
  53         else {
  54             # there is a tag but we didn't find the contents
  55             $value="[weird]";
  56         }
  57     }
  58     else {
  59         $value="";
  60     }
  61     return ($name, $value);
  62 }
  63
  64
  65 while(<STDIN>) {
  66     $line = $_;
  67     push @indoc, $line;
  68     $line=~ s/\n//g;
  69     $line=~ s/\r//g;
  70     $in=$in.$line;
  71 }
  72
  73 while($in =~ /[^<]*(<[^>]+>)/g ) {
  74     # we have a tag in $1
  75     $tag = $1;
  76
  77     if($tag =~ /^<!--/) {
  78         # this is a comment tag, ignore it
  79     }
  80     else {
  81         if(!$form &&
  82            ($tag =~ /^< *form/i )) {
  83             $method= $tag;
  84             if($method =~ /method *=/i) {
  85                 $method=~ s/.*method *= *(\"|)([^ \">]*).*/$2/gi;
  86             }
  87             else {
  88                 $method="get"; # default method
  89             }
  90             $action= $tag;
  91             $action=~ s/.*action *= *(\'|\"|)([^ \"\'>]*).*/$2/gi;
  92
  93             $method=uc($method);
  94
  95             $enctype=$tag;
  96             if ($enctype =~ /enctype *=/) {
  97                 $enctype=~ s/.*enctype *= *(\'|\"|)([^ \"\'>]*).*/$2/gi;
  98
  99                 if($enctype eq "multipart/form-data") {
 100                     $enctype="multipart form upload [use -F]"
 101                 }
 102                 $enctype = "\n--- type: $enctype";
 103             }
 104             else {
 105                 $enctype="";
 106             }
 107
 108             print "--- FORM report. Uses $method to URL \"$action\"$enctype\n";
 109             $form=1;
 110         }
 111         elsif($form &&
 112               ($tag =~ /< *\/form/i )) {
 113
 114             print "--- end of FORM\n";
 115             $form=0;
 116             if( 0 ) {
 117                 print "*** Fill in all or any of these: (default assigns may be shown)\n";
 118                 for(@vars) {
 119                     $var = $_;
 120                     $def = $value{$var};
 121                     print "$var=$def\n";
 122                 }
 123                 print "*** Pick one of these:\n";
 124                 for(@alts) {
 125                     print "$_\n";
 126                 }
 127             }
 128             undef @vars;
 129             undef @alts;
 130         }
 131         elsif($form &&
 132               ($tag =~ /^< *(input|select)/i)) {
 133             $mtag = $1;
 134
 135             ($name, $value)=namevalue($tag);
 136
 137             if($mtag =~ /select/i) {
 138                 print "Select: NAME=\"$name\"\n";
 139                 push @vars, "$name";
 140                 $select = 1;
 141             }
 142             else {
 143                 $type=$tag;
 144                 if($type =~ /type *=/i) {
 145                     $type =~ s/.*type *= *(\'|\"|)([^ \"\'>]*).*/$2/gi;
 146                 }
 147                 else {
 148                     $type="text"; # default type
 149                 }
 150                 $type=uc($type);
 151                 if(lc($type) eq "reset") {
 152                     # reset types are for UI only, ignore.
 153                 }
 154                 elsif($name eq "") {
 155                     # let's read the value parameter
 156
 157                     print "Button: \"$value\" ($type)\n";
 158                     push @alts, "$value";
 159                 }
 160                 else {
 161                     print "Input: NAME=\"$name\"";
 162                     if($value ne "") {
 163                         print " VALUE=\"$value\"";
 164                     }
 165                     print " ($type)\n";
 166                     push @vars, "$name";
 167                     # store default value:
 168                     $value{$name}=$value;
 169                 }
 170             }
 171         }
 172         elsif($form &&
 173               ($tag =~ /^< *textarea/i)) {
 174             my ($name, $value)=namevalue($tag);
 175
 176             print "Textarea: NAME=\"$name\"\n";
 177         }
 178         elsif($select) {
 179             if($tag =~ /^< *\/ *select/i) {
 180                 print "[end of select]\n";
 181                 $select = 0;
 182             }
 183             elsif($tag =~ /[^\/] *option/i ) {
 184                 my ($name, $value)=namevalue($tag);
 185                 my $s;
 186                 if($tag =~ /selected/i) {
 187                     $s= " (SELECTED)";
 188                 }
 189                 print "  Option VALUE=\"$value\"$s\n";
 190             }
 191         }
 192     }
 193 }