Author: sparky
Date: Thu Oct 22 16:17:08 2009
New Revision: 10815
Modified:
toys/rsget.pl/RSGet/Form.pm
Log:
- allow values with white spaces
Modified: toys/rsget.pl/RSGet/Form.pm
==============================================================================
--- toys/rsget.pl/RSGet/Form.pm (original)
+++ toys/rsget.pl/RSGet/Form.pm Thu Oct 22 16:17:08 2009
@@ -18,27 +18,23 @@
}
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 ];
+ my $attr = split_attributes( $1 || "" );
+ $attr->{body} = $fbody;
+ push @forms, $attr;
}
unless ( @forms ) {
warn "No forms found\n" if verbose( 2 );
dump_to_file( $html, "html" ) if setting( "debug" );
return undef unless $opts{fallback};
- push @forms, [ {}, '' ];
+ push @forms, { body => '' };
}
my $found;
foreach my $attr ( qw(id name) ) {
if ( not $found and $opts{ $attr } ) {
foreach my $form ( @forms ) {
- if ( $form->[0]->{$attr} and
$form->[0]->{$attr} eq $opts{$attr} ) {
+ if ( $form->{$attr} and $form->{$attr} eq
$opts{$attr} ) {
$found = $form;
last;
}
@@ -53,12 +49,8 @@
foreach my $form ( @forms ) {
foreach my $k ( keys %$m ) {
my $match = $m->{$k};
- if ( $k eq "body" ) {
- next EACH_FORM unless $form->[1] =~
m{$match};
- } else {
- next EACH_FORM unless exists
$form->[0]->{$k};
- next EACH_FORM unless $form->[0]->{$k}
=~ m{$match};
- }
+ next EACH_FORM unless exists $form->{$k};
+ next EACH_FORM unless $form->{$k} =~ m{$match};
}
$found = $form;
last;
@@ -80,7 +72,8 @@
}
return undef unless $found;
- my ( $attr, $fbody ) = @$found;
+ my $attr = $found;
+ my $fbody = $attr->{body};
my $self = {};
$self->{action} = $attr->{action} || "";
@@ -89,23 +82,18 @@
my %values;
my $formelements = join "|",
qw(input button select optgroup option textarea isindex);
- while ( $fbody =~ s{^.*?<($formelements)(\s+.*?)?\s*/?\s*>}{}si ) {
+ 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};
+ my $attr = split_attributes( $2 || "" );
+ 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} || "";
+ if ( $el eq "input" and lc $attr->{type} eq "hidden" ) {
+ $values{ $name } = $attr->{value} || "";
}
}
$self->{order} = \...@order;
@@ -114,6 +102,31 @@
return bless $self, $class;
}
+sub split_attributes
+{
+ local $_ = shift;
+ my %attr;
+ while ( s/^\s*([a-z0-9_]+)([=\s])//i ) {
+ my $name = lc $1;
+ my $eq = $2;
+ if ( $eq eq "=" ) {
+ my $value;
+ if ( s/^(["'])// ) {
+ my $quot = $1;
+ s/^(.*?)$quot//;
+ $value = $1;
+ } else {
+ s/(\S+)//;
+ $value = $1;
+ }
+ $attr{ $name } = de_ml( $value || "" );
+ } else {
+ $attr{ $name } = $name;
+ }
+ }
+ return \%attr;
+}
+
sub set
{
my $self = shift;
_______________________________________________
pld-cvs-commit mailing list
[email protected]
http://lists.pld-linux.org/mailman/listinfo/pld-cvs-commit
