/usr/share/perl5/Net/Google/Code/Role/HTMLTree.pm is in libnet-google-code-perl 0.19-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 | package Net::Google::Code::Role::HTMLTree;
use Any::Moose 'Role';
use HTML::TreeBuilder;
use Params::Validate qw(:all);
use Scalar::Util qw/blessed/;
sub html_tree {
my $self = shift;
my %args = validate( @_, { html => { type => SCALAR } } );
my $tree = HTML::TreeBuilder->new;
$tree->parse_content($args{html});
$tree->elementify;
return $tree;
}
sub html_tree_contains {
my $self = shift;
my %args = validate(
@_,
{
html => { type => SCALAR },
look_down => { type => ARRAYREF, optional => 1 },
# SCALARREF is for the regex
as_text => { type => SCALAR | SCALARREF },
}
);
my $tree;
my $need_delete;
if ( blessed $args{html} ) {
$tree = $args{html};
}
else {
$tree = $self->html_tree( html => $args{html} );
$need_delete = 1;
}
my $part = $tree;
if ( $args{look_down} ) {
($part) = $tree->look_down( @{ $args{look_down} } );
}
my $text = $part && $part->as_text;
$tree->delete if $need_delete;
return unless defined $text;
return 1 if $text eq $args{as_text};
if ( ( ref $args{as_text} eq 'Regexp' ) && ( my @captures =
$text =~ $args{as_text} ) )
{
# note, if there's no captures at all but the string matches,
# @captures will be set to (1), so don't use @captures unless you
# know there's some capture in the regex
return wantarray ? ( 1, @captures ) : 1;
}
return;
}
no Any::Moose;
1;
__END__
=head1 NAME
Net::Google::Code::Role::HTMLTree - HTMLTree Role
=head1 DESCRIPTION
=head1 INTERFACE
=head2 html_tree
return a new HTML::TreeBuilder object, with current content parsed
=head2 html_tree_contains
a help method to help test if the current content contains some stuff, args are:
look_down => [ look_down's args ]
as_text => qr/foo/
look_down is used to limit the area,
as_text's value can be regex or string
=head1 AUTHOR
sunnavy C<< <sunnavy@bestpractical.com> >>
=head1 LICENCE AND COPYRIGHT
Copyright 2008-2010 Best Practical Solutions.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
|