Author: sparky
Date: Fri Oct 2 17:27:28 2009
New Revision: 10651
Added:
toys/rsget.pl/RSGet/Form.pm (contents, props changed)
Modified:
toys/rsget.pl/RSGet/Get.pm
Log:
- add Form.pm -- extracts forms from html page and prepares post values
Added: toys/rsget.pl/RSGet/Form.pm
==============================================================================
--- (empty file)
+++ toys/rsget.pl/RSGet/Form.pm Fri Oct 2 17:27:28 2009
@@ -0,0 +1,157 @@
+package RSGet::Form;
+
+use strict;
+use warnings;
+use RSGet::Tools;
+use URI::Escape;
+set_rev qq$Id$;
+
+sub new
+{
+ my $class = shift;
+ my $html = shift;
+ my %opts = @_;
+
+ my @forms;
+ while ( $html =~ s{^.*?<form\s*(.*?)>(.*?)</form>}{}si ) {
+ my $attr = $1;
+ my $fbody = $2;
+ my %attr = map {
+ /^(.*?)=(["'])(.*)\2$/
+ ? ( lc $1, $3 )
+ : ( $_, undef )
+ } split /\s+/, $attr;
+ push @forms, [ \%attr, $fbody ];
+ }
+ unless ( @forms ) {
+ warn "No forms found\n";
+ dump_to_file( $html, "html" );
+ return undef;
+ }
+
+ my $found;
+ if ( not $found and $opts{id} ) {
+ foreach my $form ( @forms ) {
+ if ( $form->[0]->{id} and $form->[0]->{id} eq $opts{id}
) {
+ $found = $form;
+ last;
+ }
+ }
+ warn "Can't find form with id '$opts{id}'\n" unless $found;
+ }
+ if ( not $found and $opts{name} ) {
+ foreach my $form ( @forms ) {
+ if ( $form->[0]->{name} and $form->[0]->{name} eq
$opts{name} ) {
+ $found = $form;
+ last;
+ }
+ }
+ warn "Can't find form with name '$opts{name}'\n" unless $found;
+ }
+ if ( not $found and $opts{num} ) {
+ if ( $opts{num} >= 0 and $opts{num} < scalar @forms ) {
+ $found = $forms[ $opts{num} ];
+ }
+ warn "Can't find form number $opts{num}\n" unless $found;
+ }
+ if ( not $found ) {
+ $found = $forms[ 0 ];
+ }
+
+ my ( $attr, $fbody ) = @$found;
+
+ my $self = {};
+ $self->{action} = $attr->{action} || "";
+ $self->{post} = 1 if lc $attr->{method} eq "post";
+ my @order;
+ my %values;
+ my $formelements = join "|",
+ qw(input button select optgroup option textarea isindex);
+ while ( $fbody =~ s{^.*?<($formelements)(\s+.*?)?\s*/?\s*>}{}si ) {
+ my $el = lc $1;
+ my $attr = $2;
+ my %attr = map {
+ /^(.*?)=(["'])(.*)\2$/
+ ? ( lc $1, $3 )
+ : ( $_, undef )
+ } split /\s+/, $attr;
+ my $name = $attr{name};
+ next unless $name;
+
+ unless ( exists $values{ $name } ) {
+ push @order, $name;
+ $values{ $name } = undef;
+ }
+ if ( $el eq "input" and lc $attr{type} eq "hidden" ) {
+ $values{ $name } = $attr{value} || "";
+ }
+ }
+ $self->{order} = \...@order;
+ $self->{values} = \%values;
+
+ return bless $self, $class;
+}
+
+sub set
+{
+ my $self = shift;
+ my $key = shift;
+ my $value = shift;
+
+ unless ( exists $self->{values}->{$key} ) {
+ warn "'$key' does not exist\n" if verbose( 1 );
+ push @{$self->{order}}, $key;
+ }
+
+ $self->{values}->{$key} = $value;
+}
+
+sub get
+{
+ my $self = shift;
+ my $key = shift;
+
+ if ( $self->{values}->{$key} ) {
+ return $self->{values}->{$key};
+ } else {
+ warn "'$key' does not exist\n";
+ return undef;
+ }
+}
+
+sub dump
+{
+ my $self = shift;
+ my $p = "action: $self->{action}\n";
+ $p .= "method: " . ( $self->{post} ? "post" : "get" ) . "\n";
+ $p .= "values:\n";
+ my $vs = $self->{values};
+ foreach my $k ( @{$self->{order}} ) {
+ my $v = $vs->{$k};
+ $v = "undef" unless defined $v;
+ $p .= " $k => $v\n";
+ }
+
+ dump_to_file( $p, "post" );
+}
+
+sub post
+{
+ my $self = shift;
+
+ my $vs = $self->{values};
+ my $post = join "&",
+ map { uri_escape( $_ ) . "=" . uri_escape( $vs->{ $_ } ) }
+ grep { defined $vs->{ $_ } }
+ @{$self->{order}};
+
+ if ( $self->{post} ) {
+ return $self->{action}, post => $post;
+ } else {
+ return $self->{action} . "?" . $post;
+ }
+}
+
+1;
+
+# vim:ts=4:sw=4
Modified: toys/rsget.pl/RSGet/Get.pm
==============================================================================
--- toys/rsget.pl/RSGet/Get.pm (original)
+++ toys/rsget.pl/RSGet/Get.pm Fri Oct 2 17:27:28 2009
@@ -4,6 +4,7 @@
use warnings;
use RSGet::Tools;
use RSGet::Captcha;
+use RSGet::Form;
use RSGet::Wait;
use URI;
set_rev qq$Id$;
@@ -51,7 +52,7 @@
bless $self, $pkg;
$self->bestinfo();
- if ( setting("verbose") > 1 or $cmd eq "get" ) {
+ if ( verbose( 2 ) or $cmd eq "get" ) {
my $outifstr = $outif ? "[$outif]" : "";
hadd $self,
@@ -101,6 +102,12 @@
return 0;
}
+sub form
+{
+ my $self = shift;
+ return new RSGet::Form( $self->{body}, @_ );
+}
+
sub print
{
my $self = shift;
@@ -295,7 +302,7 @@
return 0 unless $self->{_cmd} eq "check";
p "info( $self->{_uri} ): $self->{bestname} ($self->{bestsize})\n"
- if setting("verbose") > 0;
+ if verbose( 1 );
RSGet::Dispatch::finished( $self );
return 1;
}
_______________________________________________
pld-cvs-commit mailing list
[email protected]
http://lists.pld-linux.org/mailman/listinfo/pld-cvs-commit
