aboutsummaryrefslogtreecommitdiffhomepage
path: root/examples/data/uzbl/scripts/formfiller.pl
diff options
context:
space:
mode:
authorGravatar Dieter Plaetinck <dieter@plaetinck.be>2009-06-07 22:37:44 +0200
committerGravatar Dieter Plaetinck <dieter@plaetinck.be>2009-06-07 22:37:44 +0200
commit19489f84dbf0316222e27216c622929492d6fe4d (patch)
treecfa7f7f6c907edcc1b2c1e6cf53467b44146f935 /examples/data/uzbl/scripts/formfiller.pl
parent6cccec4508d6b0290e04716459db6a5790b2a072 (diff)
make the whole xdg/dev directories /configs etc more sense making. now theres just one config you can directly copy into your home and use without editing. the same config can be used while developing, the Makefile just overrides 2 xdg variables. also the scripts can be a bit simpler now
Diffstat (limited to 'examples/data/uzbl/scripts/formfiller.pl')
-rwxr-xr-xexamples/data/uzbl/scripts/formfiller.pl99
1 files changed, 99 insertions, 0 deletions
diff --git a/examples/data/uzbl/scripts/formfiller.pl b/examples/data/uzbl/scripts/formfiller.pl
new file mode 100755
index 0000000..c590836
--- /dev/null
+++ b/examples/data/uzbl/scripts/formfiller.pl
@@ -0,0 +1,99 @@
+#!/usr/bin/perl
+
+# a slightly more advanced form filler
+#
+# uses settings file like: $keydir/<domain>
+
+# user arg 1:
+# edit: force editing of the file (fetches if file is missing)
+# load: fill forms from file (fetches if file is missing)
+# new: fetch new file
+
+# usage example:
+# bind LL = spawn /usr/share/uzbl/examples/scripts/formfiller.pl load
+# bind LN = spawn /usr/share/uzbl/examples/scripts/formfiller.pl new
+# bind LE = spawn /usr/share/uzbl/examples/scripts/formfiller.pl edit
+
+use strict;
+use warnings;
+
+my $keydir = $ENV{XDG_CONFIG_HOME} . "/uzbl/forms";
+my ($config,$pid,$xid,$fifoname,$socket,$url,$title,$cmd) = @ARGV;
+if (!defined $fifoname || $fifoname eq "") { die "No fifo"; }
+
+sub domain {
+ my ($url) = @_;
+ $url =~ s#http(s)?://([A-Za-z0-9\.-]+)(/.*)?#$2#;
+ return $url;
+};
+
+my $editor = "xterm -e vim";
+#my $editor = "gvim";
+
+# ideally, there would be some way to ask uzbl for the html content instead of having to redownload it with
+# Also, you may need to fake the user-agent on some sites (like facebook)
+ my $downloader = "curl -A 'Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.9.0.10) Gecko/2009042810 GranParadiso/3.0.10' ";
+#my $downloader = "curl -s";
+
+my @fields = ("type","name","value");
+
+my %command;
+
+$command{load} = sub {
+ my ($domain) = @_;
+ my $filename = "$keydir/$domain";
+ if (-e $filename){
+ open(my $file, $filename) or die "Failed to open $filename: $!";
+ my (@lines) = <$file>;
+ close($file);
+ $|++;
+ open(my $fifo, ">>", $fifoname) or die "Failed to open $fifoname: $!";
+ foreach my $line (@lines) {
+ next if ($line =~ m/^#/);
+ my ($type,$name,$value) = ($line =~ /^\s*(\w+)\s*\|\s*(.*?)\s*\|\s*(.*?)\s*$/);
+ if ($type eq "checkbox")
+ {
+ printf $fifo 'js document.getElementsByName("%s")[0].checked = %s;', $name, $value;
+ } elsif ($type eq "submit")
+ {
+ printf $fifo 'js function fs (n) {try{n.submit()} catch (e){fs(n.parentNode)}}; fs(document.getElementsByName("%s")[0]);', $name;
+ } elsif ($type ne "")
+ {
+ printf $fifo 'js document.getElementsByName("%s")[0].value = "%s";', $name, $value;
+ }
+ print $fifo "\n";
+ }
+ $|--;
+ } else {
+ $command{new}->($domain);
+ $command{edit}->($domain);
+ }
+};
+$command{edit} = sub {
+ my ($domain) = @_;
+ my $file = "$keydir/$domain";
+ if(-e $file){
+ system ($editor, $file);
+ } else {
+ $command{new}->($domain);
+ }
+};
+$command{new} = sub {
+ my ($domain) = @_;
+ my $filename = "$keydir/$domain";
+ open (my $file,">>", $filename) or die "Failed to open $filename: $!";
+ $|++;
+ print $file "# Make sure that there are no extra submits, since it may trigger the wrong one.\n";
+ printf $file "#%-10s | %-10s | %s\n", @fields;
+ print $file "#------------------------------\n";
+ my @data = `$downloader $url`;
+ foreach my $line (@data){
+ if($line =~ m/<input ([^>].*?)>/i){
+ $line =~ s/.*(<input ([^>].*?)>).*/$1/;
+ printf $file " %-10s | %-10s | %s\n", map { my ($r) = $line =~ /.*$_=["'](.*?)["']/;$r } @fields;
+ };
+ };
+ $|--;
+};
+
+$command{$cmd}->(domain($url));