vcs.maemo.org Git - uzbl-mobile/blob - examples/scripts/formfiller.pl

   1 #!/usr/bin/perl
   2
   3 # a slightly more advanced form filler
   4 #
   5 # uses settings file like: $keydir/<domain>
   6
   7 # user arg 1:
   8 # edit: force editing of the file (fetches if file is missing)
   9 # load: fill forms from file (fetches if file is missing)
  10 # new:  fetch new file
  11
  12 # usage example:
  13 # bind LL = spawn /usr/share/uzbl/examples/scripts/formfiller.pl load
  14 # bind LN = spawn /usr/share/uzbl/examples/scripts/formfiller.pl new
  15 # bind LE = spawn /usr/share/uzbl/examples/scripts/formfiller.pl edit
  16
  17 use strict;
  18 use warnings;
  19
  20 my $keydir = $ENV{XDG_CONFIG_HOME} . "/uzbl/forms";
  21 my ($config,$pid,$xid,$fifoname,$socket,$url,$title,$cmd) = @ARGV;
  22 if (!defined $fifoname || $fifoname eq "") { die "No fifo"; }
  23
  24 sub domain {
  25   my ($url) = @_;
  26   $url =~ s#http(s)?://([A-Za-z0-9\.-]+)(/.*)?#$2#;
  27   return $url;
  28 };
  29
  30 my $editor = "xterm -e vim";
  31 #my $editor = "gvim";
  32
  33 # ideally, there would be some way to ask uzbl for the html content instead of having to redownload it with
  34 #       Also, you may need to fake the user-agent on some sites (like facebook)
  35  my $downloader = "curl -A 'Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.9.0.10) Gecko/2009042810 GranParadiso/3.0.10' ";
  36 #my $downloader = "curl -s";
  37
  38 my @fields = ("type","name","value");
  39
  40 my %command;
  41
  42 $command{load} = sub {
  43   my ($domain) = @_;
  44   my $filename = "$keydir/$domain";
  45   if (-e $filename){
  46     open(my $file, $filename) or die "Failed to open $filename: $!";
  47     my (@lines) = <$file>;
  48     close($file);
  49     $|++;
  50     open(my $fifo, ">>", $fifoname) or die "Failed to open $fifoname: $!";
  51     foreach my $line (@lines) {
  52       next if ($line =~ m/^#/);
  53       my ($type,$name,$value) = ($line =~ /^\s*(\w+)\s*\|\s*(.*?)\s*\|\s*(.*?)\s*$/);
  54       if ($type eq "checkbox")
  55       {
  56         printf $fifo 'js document.getElementsByName("%s")[0].checked = %s;', $name, $value;
  57       } elsif ($type eq "submit")
  58       {
  59         printf $fifo 'js function fs (n) {try{n.submit()} catch (e){fs(n.parentNode)}}; fs(document.getElementsByName("%s")[0]);', $name;
  60       } elsif ($type ne "")
  61       {
  62         printf $fifo 'js document.getElementsByName("%s")[0].value = "%s";', $name, $value;
  63       }
  64       print $fifo "\n";
  65     }
  66     $|--;
  67   } else {
  68     $command{new}->($domain);
  69     $command{edit}->($domain);
  70   }
  71 };
  72 $command{edit} = sub {
  73   my ($domain) = @_;
  74   my $file = "$keydir/$domain";
  75   if(-e $file){
  76     system ($editor, $file);
  77   } else {
  78     $command{new}->($domain);
  79   }
  80 };
  81 $command{new} = sub {
  82   my ($domain) = @_;
  83   my $filename = "$keydir/$domain";
  84   open (my $file,">>", $filename) or die "Failed to open $filename: $!";
  85   $|++;
  86   print $file "# Make sure that there are no extra submits, since it may trigger the wrong one.\n";
  87   printf $file "#%-10s | %-10s | %s\n", @fields;
  88   print $file "#------------------------------\n";
  89   my @data = `$downloader $url`;
  90   foreach my $line (@data){
  91     if($line =~ m/<input ([^>].*?)>/i){
  92       $line =~ s/.*(<input ([^>].*?)>).*/$1/;
  93       printf $file " %-10s | %-10s | %s\n", map { my ($r) = $line =~ /.*$_=["'](.*?)["']/;$r } @fields;
  94     };
  95   };
  96   $|--;
  97 };
  98
  99 $command{$cmd}->(domain($url));