-0.009006 2011-05-20
- - Add DESTROY method to fix test failures / warnings in perl >= 5.13.1
-
0.009005 2011-05-12
- Perforce escaping of meta-characters in selectors and test (rafl)
use HTML::Zoom::TransformBuilder;
use Scalar::Util ();
-our $VERSION = '0.009006';
+our $VERSION = '0.009005';
$VERSION = eval $VERSION;
my $sel = $self->select($selector);
my $meth = our $AUTOLOAD;
$meth =~ s/.*:://;
- if(my $cr = $sel->_zconfig->filter_builder->can($meth)) {
+ if (ref($selector) eq 'HASH') {
+ my $ret = $self;
+ $ret = $ret->_do($_, $meth, @{$selector->{$_}}) for keys %$selector;
+ $ret;
+ } else {
+ $self->_do($selector, $meth, @args);
+ }
+}
+
+sub _do {
+ my ($self, $selector, $meth, @args) = @_;
+ my $sel = $self->select($selector);
+ if( my $cr = $sel->_zconfig->filter_builder->can($meth)) {
return $sel->$meth(@args);
} else {
die "We can't do $meth on ->select('$selector')";
$_->select('.name')->replace_content('Matt')
->select('.age')->replace_content('26')
},
+ # alternate form
sub {
- $_->select('.name')->replace_content('Mark')
- ->select('.age')->replace_content('0x29')
+ $_->replace_content({'.name' => ['Mark'],'.age' => ['0x29'] })
},
+ #alternate alternate form
sub {
- $_->select('.name')->replace_content('Epitaph')
- ->select('.age')->replace_content('<redacted>')
+ $_->replace_content('.name' => 'Epitaph')
+ ->replace_content('.age' => '<redacted>')
},
],
{ repeat_between => '.between' }
->add_to_attribute( for => $field->{id} )
->then
->replace_content( $field->{label} )
-
- ->select('input')
- ->add_to_attribute( name => $field->{name} )
- ->then
- ->add_to_attribute( type => $field->{type} )
- ->then
- ->add_to_attribute( value => $field->{value} )
-
+ ->add_to_attribute(
+ input => {
+ name => $field->{name},
+ type => $field->{type},
+ value => $field->{value}
+ })
} } @fields
]);
Jakub Nareski
-Simon Elliot
+Simon Elliott
Joe Highton
sub set_attribute {
my $self = shift;
- my ($name, $value) = $self->_parse_attribute_args(@_);
+ my $attr = $self->_parse_attribute_args(@_);
sub {
my $a = (my $evt = $_[0])->{attrs};
- my $e = exists $a->{$name};
+ my @kadd = grep {!exists $a->{$_}} keys %$attr;
+{ %$evt, raw => undef, raw_attrs => undef,
- attrs => { %$a, $name => $value },
- ($e # add to name list if not present
- ? ()
- : (attr_names => [ @{$evt->{attr_names}}, $name ]))
+ attrs => { %$a, %$attr },
+ @kadd ? (attr_names => [ @{$evt->{attr_names}}, @kadd ]) : ()
}
};
}
sub _parse_attribute_args {
my $self = shift;
- # allow ->add_to_attribute(name => 'value')
- # or ->add_to_attribute({ name => 'name', value => 'value' })
- die "WARNING: Long form arg (name => 'class', value => 'x') is deprecated"
- if(@_ == 1 && $_[0]->{'name'} && $_[0]->{'value'});
- my ($name, $value) = @_ > 1 ? @_ : @{$_[0]}{qw(name value)};
- return ($name, $self->_zconfig->parser->html_escape($value));
+ my $opts = ref($_[0]) eq 'HASH' ? $_[0] : {$_[0] => $_[1]};
+ for (values %{$opts}) { $self->_zconfig->parser->html_escape($_); }
+ return $opts;
}
sub add_attribute {
sub add_class { shift->add_to_attribute('class',@_) }
-sub remove_class { shift->remove_attribute('class',@_) }
+sub remove_class { shift->remove_from_attribute('class',@_) }
sub set_class { shift->set_attribute('class',@_) }
sub add_to_attribute {
my $self = shift;
- my ($name, $value) = $self->_parse_attribute_args(@_);
+ my $attr = $self->_parse_attribute_args(@_);
sub {
my $a = (my $evt = $_[0])->{attrs};
- my $e = exists $a->{$name};
+ my @kadd = grep {!exists $a->{$_}} keys %$attr;
+{ %$evt, raw => undef, raw_attrs => undef,
attrs => {
%$a,
- $name => join(' ', ($e ? $a->{$name} : ()), $value)
+ map {$_ => join(' ', (exists $a->{$_} ? $a->{$_} : ()), $attr->{$_}) }
+ keys %$attr
+ },
+ @kadd ? (attr_names => [ @{$evt->{attr_names}}, @kadd ]) : ()
+ }
+ };
+}
+
+sub remove_from_attribute {
+ my $self = shift;
+ my $attr = $self->_parse_attribute_args(@_);
+ sub {
+ my $a = (my $evt = $_[0])->{attrs};
+ +{ %$evt, raw => undef, raw_attrs => undef,
+ attrs => {
+ %$a,
+ #TODO needs to support multiple removes
+ map { my $tar = $_; $_ => join ' ',
+ map {$attr->{$tar} ne $_} split ' ', $a->{$_} }
+ grep {exists $a->{$_}} keys %$attr
},
- ($e # add to name list if not present
- ? ()
- : (attr_names => [ @{$evt->{attr_names}}, $name ]))
}
};
}
$self->repeat($repeat_for, { %{$options||{}}, content => 1 })
}
+sub extract_names {
+ my ($self, $to) = @_;
+ sub {
+ my ($evt) = @_;
+ push @$to, $evt->{'attrs'}->{'name'};
+ $evt;
+ }
+};
+
+sub validate_form {
+ my ($self,$to) = @_;
+ $self->collect({
+ filter => sub {
+ return
+ $_->select('input')->validation_rules($to)
+ ->select('select')->validation_rules($to);
+ },
+ passthrough => 1,
+ });
+}
+
+sub fill_form {
+ my ($self,$val) = @_;
+ $self->collect({
+ filter => sub {
+ return
+ $_->select('input')->val($val)
+ #->select('select')->val($val)
+ ;
+ },
+ passthrough => 1,
+ });
+}
+
+sub validation_rules {
+ my ($self, $to) = @_;
+ sub {
+ my ($evt) = @_;
+ $to->{$evt->{'attrs'}->{'name'}}
+ = [split ' ', $evt->{'attrs'}->{'data-validate'}||""];
+ $evt;
+ }
+}
+
+sub val {
+ #if val is a hashref automatically match to name, otherwise fill as is.
+ my ($self, $val) = @_;
+ sub {
+ my ($evt) = @_;
+ my $attrs = $evt->{'attrs'};
+ my $nm = $attrs->{'name'};
+ my $tar = defined $val && ref $val eq 'HASH' ? $val->{$nm} : $val;
+ if(defined $tar) {
+ if($evt->{'name'} eq 'select') {
+ #if we are select do something more complicated
+ warn "Can't do selects yet";
+ } else {
+ $evt->{'raw'} = undef;
+ $evt->{'raw_attrs'} = undef;
+ push @{$evt->{'attr_names'}}, 'value' unless exists $attrs->{'value'};
+ $attrs->{'value'} = $tar;
+ #check if we are a checkbox
+ if($attrs->{'type'} eq 'checkbox') {
+ if($tar) {
+ push @{$evt->{'attr_names'}}, 'selected' unless exists $attrs->{'selected'};
+ $attrs->{'selected'} = $tar ? 'selected' : '';
+ } else {
+ delete $attrs->{'selected'};
+ $evt->{'attr_names'} = [ grep $_ ne 'selected', @{$evt->{'attr_names'}} ];
+ }
+ }
+ }
+ }
+ $evt;
+ }
+}
+
+
1;
=head1 NAME
->select('p')
->set_attribute(class=>'paragraph')
->select('div')
- ->set_attribute({name=>'class', value=>'divider'});
-
+ ->set_attribute({class=>'paragraph', name=>'divider'});
Overrides existing values, if such exist. When multiple L</set_attribute>
calls are made against the same or overlapping selection sets, the final
Adds a value to an existing attribute, or creates one if the attribute does not
yet exist. You may call this method with either an Array or HashRef of Args.
-Here's the 'long form' HashRef:
-
- $html_zoom
- ->select('p')
- ->set_attribute(class=>'paragraph')
- ->then
- ->add_to_attribute({name=>'class', value=>'divider'});
-
-And the exact same effect using the 'short form' Array:
-
$html_zoom
->select('p')
- ->set_attribute(class=>'paragraph')
+ ->set_attribute({class => 'paragraph', name => 'test'})
->then
->add_to_attribute(class=>'divider');
->then
->remove_attribute('class');
+=head2 remove_from_attribute
+
+Removes a value from existing attribute
+
+ $html_zoom
+ ->select('p')
+ ->set_attribute(class=>'paragraph lead')
+ ->then
+ ->remove_from_attribute('class' => 'lead');
+
Removes attributes from the original stream or events already added.
+=head2 add_class
+
+Add to a class attribute
+
+=head2 remove_class
+
+Remove from a class attribute
+
=head2 transform_attribute
Transforms (or creates or deletes) an attribute by running the passed
sub AUTOLOAD {
my ($self, $selector, @args) = @_;
+ my $sel = $self->select($selector);
my $meth = our $AUTOLOAD;
$meth =~ s/.*:://;
- return $self = $self->select($selector)->$meth(@args);
+ if (ref($selector) eq 'HASH') {
+ my $ret = $self;
+ $ret = $ret->_do($_, $meth, @{$selector->{$_}}) for keys %$selector;
+ $ret;
+ } else {
+ $self->_do($selector, $meth, @args);
+ }
+}
+
+sub _do {
+ my ($self, $selector, $meth, @args) = @_;
+ return $self->select($selector)->$meth(@args);
}
sub DESTROY {}
-
+
1;
my $tmpl = <<END;
<body>
- <div class="main">
+ <div name="cow" class="main">
<span class="hilight name">Bob</span>
<span class="career">Builder</span>
<hr />
'set attribute on existing attribute'
);
+($expect = $tmpl) =~ s/name="cow" class="main"/name="bar" class="foo"/;
+
+is(
+ run_for { $_->set_attr({ 'class' => 'foo', 'name' => 'bar'}) },
+ $expect,
+ 'set attributes using hashref form (shorthand)'
+);
+
($expect = $tmpl) =~ s/class="main"/class="main" foo="bar"/;
is(
'add attribute on existing attribute'
);
+($expect = $tmpl) =~ s/class="main"/class="main foo"/;
+
+is(
+ run_for { $_->add_class('foo') },
+ $expect,
+ 'add attribute on existing attribute (shorthand)'
+);
+
+($expect = $tmpl) =~ s/class="main"/class="main" id="foo"/;
+
+is(
+ run_for { $_->set_id('foo') },
+ $expect,
+ 'set_id (shorthand)'
+);
+
($expect = $tmpl) =~ s/class="main"/class="main" foo="bar"/;
is(
'remove attribute on non existing attribute'
);
+($expect = $tmpl) =~ s/class="main"/class=""/;
+
+is(
+ run_for { $_->remove_from_attribute({ class => 'main' }) },
+ $expect,
+ 'remove name from attribute'
+);
+
+is(
+ run_for { $_->remove_from_attribute({ madeup => 'main' }) },
+ $tmpl,
+ 'remove name from non existing attribute (ignored)'
+);
+
+($expect = $tmpl) =~ s/class="main"/class=""/;
+
+is(
+ run_for { $_->remove_class( 'main' ) },
+ $expect,
+ 'remove_class'
+);
+
($expect = $tmpl) =~ s/ class="main"//;
is(
is(
HTML::Zoom::Producer::BuiltIn->html_from_events(\@ev),
- '<div class="main">
+ '<div name="cow" class="main">
<span class="hilight name">Bob</span>
<span class="career">Builder</span>
<hr />
is(
run_for { $_->collect({ into => \@ev, content => 1 }) },
'<body>
- <div class="main"></div>
+ <div name="cow" class="main"></div>
</body>
',
'collect w/content removes correctly'
is(
run_for { $_->replace($ohai, { content => 1 }) },
'<body>
- <div class="main">O HAI</div>
+ <div name="cow" class="main">O HAI</div>
</body>
',
'replace w/content'
)
},
q{<body>
- <div class="main">
+ <div name="cow" class="main">
<span class="hilight name">mst</span>
<span class="career">Chainsaw Wielder</span>
<hr />
- </div><div class="main">
+ </div><div name="cow" class="main">
<span class="hilight name">mdk</span>
<span class="career">Adminion</span>
<hr />
)
},
q{<body>
- <div class="main">
+ <div name="cow" class="main">
<span class="hilight name">mst</span>
<span class="career">Chainsaw Wielder</span>
<hr />
)
},
q{<body>
- <div class="main">
+ <div name="cow" class="main">
<span class="hilight name">mst</span>
<span class="career">Chainsaw Wielder</span>
<hr />
)
},
q{<body>
- <div class="main">
+ <div name="cow" class="main">
<span class="hilight name">mst</span>
<span class="career">Chainsaw Wielder</span>
<hr />
'Got correct from repeat_content';
}
+{
+ ok my $dwim = HTML::Zoom
+ ->from_html(q[<ul><li class="foo"></li><li class="bar"></li></ul>])
+ ->replace_content({
+ 'li.foo' => ['foo'],
+ 'li.bar' => ['bar'],
+ })->to_html;
+ is $dwim, '<ul><li class="foo">foo</li><li class="bar">bar</li></ul>',
+ 'Hashref selectors (via replace_content)';
+}
+
+{
+ ok my $dwim = HTML::Zoom
+ ->from_html(q[<ul><li class="foo"></li><li class="bar"></li></ul>])
+ ->set_attribute({
+ 'li.foo' => [ class => 'baz' ],
+ 'li.bar' => [ class => 'qux' ],
+ })->to_html;
+ is $dwim, '<ul><li class="baz"></li><li class="qux"></li></ul>',
+ 'Hashref selectors (via set_attribute)';
+}
+
+{
+ ok my $dwim = HTML::Zoom
+ ->from_html(q[<ul><li class="foo"></li><li class="bar"></li></ul>])
+ ->select('ul')->collect({
+ passthrough => 1,
+ filter => sub {
+ $_->set_attribute({
+ 'li.foo' => [ class => 'baz' ],
+ 'li.bar' => [ class => 'qux' ],
+ });
+ }
+ })->to_html;
+ is $dwim, '<ul><li class="baz"></li><li class="qux"></li></ul>',
+ 'Hashref selectors on codestream';
+}
+
+{
+ ok my $dwim = HTML::Zoom
+ ->from_html(q[<ul><li class="foo" name="bar"></li><li class="bar"></li></ul>])
+ ->select('ul')->collect({
+ passthrough => 1,
+ filter => sub {
+ $_->set_attribute({
+ 'li.foo' => [{ class => 'baz', name => 'moo', }],
+ 'li.bar' => [ class => 'qux' ],
+ });
+ }
+ })->to_html;
+ is $dwim, '<ul><li class="baz" name="moo"></li><li class="qux"></li></ul>',
+ 'Hashref selectors with hashref attributes on codestream';
+}
+
done_testing;
--- /dev/null
+use strictures 1;
+use Test::More;
+use Test::More;
+
+use HTML::Zoom;
+
+my $tmpl =<<END;
+<body>
+ <form name="main">
+ <label for="input_field">Input</label>
+ <input data-validate="required" type="text" name="input_field" />
+ <label for="input_field2">Input 2</label>
+ <input data-validate="required" value="gorch" type="text" name="input_field2" />
+
+ <label for="input_check">Checkbox</label>
+ <input data-validate="required" value="0" type="checkbox" name="input_check" />
+
+ <label for="select_field">Select</label>
+ <select data-validate="required" name="select_field">
+ <option value="1">foo</option>
+ <option value="2">bar</option>
+ <option value="3" selected="selected">oof</option>
+ <option value="4">rab</option>
+ </select>
+ <label for="select_field">Select 2</label>
+ <select data-validate="required" name="select_field2">
+ <option value="1">foo</option>
+ <option value="2">bar</option>
+ <option value="3">oof</option>
+ <option value="4">rab</option>
+ </select>
+
+ </form>
+</body>
+END
+
+my $z = HTML::Zoom->from_html($tmpl);
+
+my ($expect);
+
+($expect = $tmpl) =~ s/name="input_field" /name="input_field" value="testval" /;
+
+is(
+ $z->select('input[name="input_field"]')->val('testval')->to_html,
+ $expect,
+ 'set value on input=text'
+);
+
+$z = HTML::Zoom->from_html($tmpl);
+($expect = $tmpl) =~ s/value="0" type="checkbox" name="input_check" /value="1" type="checkbox" name="input_check" selected="selected" /;
+
+is(
+ $z->select('input[name="input_check"]')->val(1)->to_html,
+ $expect,
+ 'set value on input=checkbox'
+);
+
+($expect = $tmpl) =~ s/value="1" type="checkbox" name="input_check" selected="selected" \>/value="0" type="checkbox" name="input_check" \>/;
+
+is(
+ $z->select('input[name="input_check"]')->val(0)->to_html,
+ $expect,
+ 'remove value on input=checkbox'
+);
+
+$z = HTML::Zoom->from_html($tmpl);
+($expect = $tmpl) =~ s/name="input_field" /name="input_field" value="testval" /;
+
+is(
+ $z->select('input')->val({input_field => "testval"})->to_html,
+ $expect,
+ 'alternate fill'
+);
+
+
+SKIP: {
+ skip "not implemented",1;
+ $z = HTML::Zoom->from_html($tmpl);
+ ($expect = $tmpl) =~ s/option value="2" /option value="2" selected="selected" /;
+
+ is(
+ $z->select('select[name="select_field"]')->val(2)->to_html,
+ $expect,
+ 'Set value on select'
+ );
+
+}
+
+my %rules;
+$z->select('form')->validate_form(\%rules)->to_html;
+is(scalar keys %rules, 5, "Correctly extracted validation info");
+
+done_testing();
projects / catagits/HTML-Zoom.git / commitdiff