[Bps-public-commit] r19674 - in Net-Google-Code/trunk: . lib/Net/Google lib/Net/Google/Code lib/Net/Google/Code/Issue lib/Net/Google/Code/Wiki

sunnavy at bestpractical.com sunnavy at bestpractical.com
Thu May 14 22:50:28 EDT 2009


Author: sunnavy
Date: Thu May 14 22:50:28 2009
New Revision: 19674

Added:
   Net-Google-Code/trunk/lib/Net/Google/Code/Role/Authentication.pm
   Net-Google-Code/trunk/lib/Net/Google/Code/Role/HTMLTree.pm
Modified:
   Net-Google-Code/trunk/   (props changed)
   Net-Google-Code/trunk/Makefile.PL
   Net-Google-Code/trunk/README
   Net-Google-Code/trunk/lib/Net/Google/Code.pm
   Net-Google-Code/trunk/lib/Net/Google/Code/Download.pm
   Net-Google-Code/trunk/lib/Net/Google/Code/Issue.pm
   Net-Google-Code/trunk/lib/Net/Google/Code/Issue/Attachment.pm
   Net-Google-Code/trunk/lib/Net/Google/Code/Issue/Comment.pm
   Net-Google-Code/trunk/lib/Net/Google/Code/Issue/Search.pm
   Net-Google-Code/trunk/lib/Net/Google/Code/Wiki.pm
   Net-Google-Code/trunk/lib/Net/Google/Code/Wiki/Comment.pm

Log:
 r19664 at sunnavys-mb (orig r18266):  sunnavy | 2009-02-06 10:12:29 +0800
 - Create branch write
 r19678 at sunnavys-mb (orig r18273):  sunnavy | 2009-02-07 17:33:26 +0800
  r19670 at sunnavys-mb:  sunnavy | 2009-02-07 17:31:59 +0800
  added Authentication role
 
 r19679 at sunnavys-mb (orig r18274):  sunnavy | 2009-02-07 17:33:41 +0800
  r19671 at sunnavys-mb:  sunnavy | 2009-02-07 17:32:39 +0800
  add Authentication role to Role.pm
 
 r19680 at sunnavys-mb (orig r18275):  sunnavy | 2009-02-07 17:33:50 +0800
  r19672 at sunnavys-mb:  sunnavy | 2009-02-07 17:33:00 +0800
  add Term::ReadPassword as a dep
 
 r19684 at sunnavys-mb (orig r18276):  sunnavy | 2009-02-07 17:46:55 +0800
  r19681 at sunnavys-mb:  sunnavy | 2009-02-07 17:42:32 +0800
  follow the login link if the current page has one
 
 r19685 at sunnavys-mb (orig r18277):  sunnavy | 2009-02-07 17:47:05 +0800
  r19682 at sunnavys-mb:  sunnavy | 2009-02-07 17:43:30 +0800
  added signout method
 
 r19686 at sunnavys-mb (orig r18278):  sunnavy | 2009-02-07 17:47:24 +0800
  r19683 at sunnavys-mb:  sunnavy | 2009-02-07 17:46:45 +0800
  a bit improvement for the password test
 
 r19696 at sunnavys-mb (orig r18283):  sunnavy | 2009-02-09 14:47:52 +0800
  r19687 at sunnavys-mb:  sunnavy | 2009-02-09 09:43:32 +0800
  added signed_in method, also alias signin and signout to sign_in and sign_out, respectively
 
 r19697 at sunnavys-mb (orig r18284):  sunnavy | 2009-02-09 14:48:41 +0800
  r19693 at sunnavys-mb:  sunnavy | 2009-02-09 13:03:08 +0800
  improvement authentication
 
 r19698 at sunnavys-mb (orig r18285):  sunnavy | 2009-02-09 14:48:53 +0800
  r19694 at sunnavys-mb:  sunnavy | 2009-02-09 13:04:30 +0800
  trans email and password too whe init an object
 
 r19699 at sunnavys-mb (orig r18286):  sunnavy | 2009-02-09 14:49:08 +0800
  r19695 at sunnavys-mb:  sunnavy | 2009-02-09 14:44:56 +0800
  added update method
 
 r19701 at sunnavys-mb (orig r18287):  sunnavy | 2009-02-09 15:27:10 +0800
  r19700 at sunnavys-mb:  sunnavy | 2009-02-09 15:26:55 +0800
  since label have multiple values, we need to set it seperately
 
 r19712 at sunnavys-mb (orig r18288):  sunnavy | 2009-02-09 19:53:11 +0800
  r19702 at sunnavys-mb:  sunnavy | 2009-02-09 15:31:50 +0800
  tiny order change
 
 r19713 at sunnavys-mb (orig r18289):  sunnavy | 2009-02-09 19:53:25 +0800
  r19703 at sunnavys-mb:  sunnavy | 2009-02-09 16:56:43 +0800
  added HTMLTree role
 
 r19714 at sunnavys-mb (orig r18290):  sunnavy | 2009-02-09 19:53:50 +0800
  r19704 at sunnavys-mb:  sunnavy | 2009-02-09 16:57:13 +0800
  add HTMLTree role to Role.pm
 
 r19715 at sunnavys-mb (orig r18291):  sunnavy | 2009-02-09 19:54:51 +0800
  r19705 at sunnavys-mb:  sunnavy | 2009-02-09 17:05:15 +0800
  use HTMLTree role
 
 r19716 at sunnavys-mb (orig r18292):  sunnavy | 2009-02-09 19:55:34 +0800
  r19706 at sunnavys-mb:  sunnavy | 2009-02-09 17:42:45 +0800
  better detect sign in or out
 
 r19717 at sunnavys-mb (orig r18293):  sunnavy | 2009-02-09 19:56:07 +0800
  r19707 at sunnavys-mb:  sunnavy | 2009-02-09 17:43:23 +0800
  it is better to let html_tree parse content
 
 r19718 at sunnavys-mb (orig r18294):  sunnavy | 2009-02-09 19:56:39 +0800
  r19708 at sunnavys-mb:  sunnavy | 2009-02-09 19:48:20 +0800
  added an html attribute to save the content of html
 
 r19719 at sunnavys-mb (orig r18295):  sunnavy | 2009-02-09 19:56:55 +0800
  r19709 at sunnavys-mb:  sunnavy | 2009-02-09 19:51:12 +0800
  refactor code to use more htmltree role
 
 r19720 at sunnavys-mb (orig r18296):  sunnavy | 2009-02-09 19:57:31 +0800
  r19710 at sunnavys-mb:  sunnavy | 2009-02-09 19:51:43 +0800
  old html is change to wiki_html in WikiEntry
 
 r19721 at sunnavys-mb (orig r18297):  sunnavy | 2009-02-09 19:57:45 +0800
  r19711 at sunnavys-mb:  sunnavy | 2009-02-09 19:52:07 +0800
  BUILD is private too, update pod-coverage.t for this
 
 r19723 at sunnavys-mb (orig r18298):  sunnavy | 2009-02-09 20:17:56 +0800
  r19722 at sunnavys-mb:  sunnavy | 2009-02-09 20:16:20 +0800
  update the object too when update an issue
 
 r19734 at sunnavys-mb (orig r18308):  sunnavy | 2009-02-10 08:58:08 +0800
  r19724 at sunnavys-mb:  sunnavy | 2009-02-10 08:57:38 +0800
  no more signin and signout
 
 r19741 at sunnavys-mb (orig r18313):  sunnavy | 2009-02-10 13:52:59 +0800
  r19739 at sunnavys-mb:  sunnavy | 2009-02-10 11:05:10 +0800
  rename label arg in update sub to labels
 
 r19742 at sunnavys-mb (orig r18314):  sunnavy | 2009-02-10 13:53:25 +0800
  r19740 at sunnavys-mb:  sunnavy | 2009-02-10 11:06:12 +0800
  signin does not exist any more
 
 r19744 at sunnavys-mb (orig r18315):  sunnavy | 2009-02-10 19:44:12 +0800
  r19743 at sunnavys-mb:  sunnavy | 2009-02-10 19:42:52 +0800
  added files arg for update, though it does not work yet right now
 
 r19754 at sunnavys-mb (orig r18316):  sunnavy | 2009-02-10 20:45:26 +0800
  r19745 at sunnavys-mb:  sunnavy | 2009-02-10 19:52:57 +0800
  clean
 
 r19755 at sunnavys-mb (orig r18317):  sunnavy | 2009-02-10 20:45:37 +0800
  r19746 at sunnavys-mb:  sunnavy | 2009-02-10 20:10:03 +0800
  a bit loose regex, since google is not always consistent in cases
 
 r19756 at sunnavys-mb (orig r18318):  sunnavy | 2009-02-10 20:45:47 +0800
  r19747 at sunnavys-mb:  sunnavy | 2009-02-10 20:19:45 +0800
  more loose check the sign in/out stuff, google sucks
 
 r19757 at sunnavys-mb (orig r18319):  sunnavy | 2009-02-10 20:46:07 +0800
  r19748 at sunnavys-mb:  sunnavy | 2009-02-10 20:20:57 +0800
  return captures when possible for method html_contains
 
 r19758 at sunnavys-mb (orig r18320):  sunnavy | 2009-02-10 20:46:19 +0800
  r19749 at sunnavys-mb:  sunnavy | 2009-02-10 20:24:06 +0800
  added create method for issue
 
 r19759 at sunnavys-mb (orig r18321):  sunnavy | 2009-02-10 20:46:29 +0800
  r19750 at sunnavys-mb:  sunnavy | 2009-02-10 20:35:47 +0800
  refactor a bit, split the labels transform to a method
 
 r19760 at sunnavys-mb (orig r18322):  sunnavy | 2009-02-10 20:46:47 +0800
  r19751 at sunnavys-mb:  sunnavy | 2009-02-10 20:43:54 +0800
  tiny fix
 
 r19761 at sunnavys-mb (orig r18323):  sunnavy | 2009-02-10 20:47:14 +0800
  r19752 at sunnavys-mb:  sunnavy | 2009-02-10 20:44:30 +0800
  let's sort labels_array
 
 r19762 at sunnavys-mb (orig r18324):  sunnavy | 2009-02-10 20:47:34 +0800
  r19753 at sunnavys-mb:  sunnavy | 2009-02-10 20:45:09 +0800
  tests for labels_array
 
 r20003 at sunnavys-mb (orig r18492):  sunnavy | 2009-02-20 16:48:07 +0800
  r20002 at sunnavys-mb:  sunnavy | 2009-02-20 16:47:53 +0800
  add files support for creating and updating issues
 
 r21194 at sunnavys-mb (orig r19638):  sunnavy | 2009-05-12 17:12:57 +0800
 rescue from the merge: make it pass again
 r21195 at sunnavys-mb (orig r19639):  sunnavy | 2009-05-12 17:32:28 +0800
 fix overdue code
 r21205 at sunnavys-mb (orig r19649):  sunnavy | 2009-05-13 13:41:36 +0800
 refactor Authentication: make a more robust signed in check
 r21211 at sunnavys-mb (orig r19655):  sunnavy | 2009-05-14 11:40:57 +0800
 refactor HTMLTree role: no fetchable role for it, no html attribute either
 r21213 at sunnavys-mb (orig r19657):  sunnavy | 2009-05-14 12:18:57 +0800
 tiny pod fix
 r21229 at sunnavys-mb (orig r19673):  sunnavy | 2009-05-15 10:49:42 +0800
 with HTMLTree role for nearly all classes


Modified: Net-Google-Code/trunk/Makefile.PL
==============================================================================
--- Net-Google-Code/trunk/Makefile.PL	(original)
+++ Net-Google-Code/trunk/Makefile.PL	Thu May 14 22:50:28 2009
@@ -12,6 +12,7 @@
 requires 'WWW::Mechanize';
 requires 'HTML::TreeBuilder';
 requires 'Params::Validate';
+requires 'Term::ReadPassword';
 
 recursive_author_tests('xt/');
 

Modified: Net-Google-Code/trunk/README
==============================================================================
--- Net-Google-Code/trunk/README	(original)
+++ Net-Google-Code/trunk/README	Thu May 14 22:50:28 2009
@@ -2,8 +2,6 @@
 
 Net::Google::Code is a simple client library for projects hosted in Google Code.
 
-Currently, only the basic read functionality is provided.
-
 Patches would be gratefully appreciated.
 
 

Modified: Net-Google-Code/trunk/lib/Net/Google/Code.pm
==============================================================================
--- Net-Google-Code/trunk/lib/Net/Google/Code.pm	(original)
+++ Net-Google-Code/trunk/lib/Net/Google/Code.pm	Thu May 14 22:50:28 2009
@@ -2,7 +2,7 @@
 
 use Moose;
 with 'Net::Google::Code::Role::Fetchable', 'Net::Google::Code::Role::URL',
-  'Net::Google::Code::Role::Pageable';
+  'Net::Google::Code::Role::Pageable', 'Net::Google::Code::Role::HTMLTree';
 
 our $VERSION = '0.05';
 
@@ -214,8 +214,6 @@
 
 Net::Google::Code is a simple client library for projects hosted in Google Code.
 
-Currently, it focuses on the basic read functionality for that is provided.
-
 =head1 INTERFACE
 
 =over 4

Modified: Net-Google-Code/trunk/lib/Net/Google/Code/Download.pm
==============================================================================
--- Net-Google-Code/trunk/lib/Net/Google/Code/Download.pm	(original)
+++ Net-Google-Code/trunk/lib/Net/Google/Code/Download.pm	Thu May 14 22:50:28 2009
@@ -3,7 +3,8 @@
 use Moose;
 use Params::Validate qw(:all);
 
-with 'Net::Google::Code::Role::Fetchable', 'Net::Google::Code::Role::URL';
+with 'Net::Google::Code::Role::Fetchable', 'Net::Google::Code::Role::URL',
+  'Net::Google::Code::Role::HTMLTree';
 
 has 'project' => (
     isa      => 'Str',

Modified: Net-Google-Code/trunk/lib/Net/Google/Code/Issue.pm
==============================================================================
--- Net-Google-Code/trunk/lib/Net/Google/Code/Issue.pm	(original)
+++ Net-Google-Code/trunk/lib/Net/Google/Code/Issue.pm	Thu May 14 22:50:28 2009
@@ -1,7 +1,8 @@
 package Net::Google::Code::Issue;
 use Moose;
 use Params::Validate qw(:all);
-with 'Net::Google::Code::Role::Fetchable', 'Net::Google::Code::Role::URL';
+with 'Net::Google::Code::Role::Fetchable', 'Net::Google::Code::Role::URL',
+     'Net::Google::Code::Role::HTMLTree';
 use Net::Google::Code::Issue::Comment;
 use Net::Google::Code::Issue::Attachment;
 
@@ -55,10 +56,7 @@
     my $self    = shift;
     my $content = shift;
 
-    require HTML::TreeBuilder;
-    my $tree = HTML::TreeBuilder->new;
-    $tree->parse_content($content);
-    $tree->elementify;
+    my $tree = $self->html_tree( content => $content );
 
     # extract summary
     my ($summary) = $tree->look_down( class => 'h3' );
@@ -128,6 +126,125 @@
 
 }
 
+sub create {
+    my $self = shift;
+    my %args = validate(
+        @_,
+        {
+            labels => { type => ARRAYREF, optional => 1 },
+            files  => { type => ARRAYREF, optional => 1 },
+            map { $_ => { type => SCALAR, optional => 1 } }
+              qw/comment summary status owner cc/,
+        }
+    );
+
+    $self->sign_in;
+    $self->fetch( $self->base_url . 'issues/entry' );
+
+    if ( $args{files} ) {
+# hack hack hack
+# manually add file fields since we don't have them in page.
+        my $html = $self->mech->content;
+        for ( 1 .. @{$args{files}} ) {
+            $html =~
+s{(?<=id="attachmentareadeventry"></div>)}{<input name="file$_" type="file">};
+        }
+        $self->mech->update_html( $html );
+    }
+
+    $self->mech->form_with_fields( 'comment', 'summary' );
+    $self->mech->field( 'label', $args{labels} );
+    if ( $args{files} ) {
+        for ( my $i = 0; $i < scalar @{ $args{files} }; $i++ ) {
+            $self->mech->field( 'file' . ($i + 1), $args{files}[$i] );
+        }
+    }
+
+    $self->mech->submit_form(
+        fields => {
+            map { $_ => $args{$_} }
+              grep { exists $args{$_} }
+              qw/comment summary status owner cc/
+        }
+    );
+
+    my ( $contains, $id ) = $self->html_tree_contains(
+        html      => $self->mech->content,
+        look_down => [ class => 'notice' ],
+        as_text   => qr/Issue\s+(\d+)/i,
+    );
+
+    if ( $contains )
+    {
+        $self->load( $id );
+        return $id;
+    }
+    else {
+        warn 'create issue failed';
+        return;
+    }
+}
+
+sub update {
+    my $self = shift;
+    my %args = validate(
+        @_,
+        {
+            labels => { type => ARRAYREF, optional => 1 },
+            files  => { type => ARRAYREF, optional => 1 },
+            map { $_ => { type => SCALAR, optional => 1 } }
+              qw/comment summary status owner merge_into cc blocked_on/,
+        }
+    );
+
+    $self->sign_in;
+    $self->fetch( $self->base_url . 'issues/detail?id=' . $self->id );
+
+    if ( $args{files} ) {
+# hack hack hack
+# manually add file fields since we don't have them in page.
+        my $html = $self->mech->content;
+        for ( 1 .. @{$args{files}} ) {
+            $html =~
+s{(?<=id="attachmentarea"></div>)}{<input name="file$_" type="file">};
+        }
+        $self->mech->update_html( $html );
+    }
+
+    $self->mech->form_with_fields( 'comment', 'summary' );
+    $self->mech->field( 'label', $args{labels} );
+    if ( $args{files} ) {
+        for ( my $i = 0; $i < scalar @{ $args{files} }; $i++ ) {
+            $self->mech->field( 'file' . ($i + 1), $args{files}[$i] );
+        }
+    }
+
+    $self->mech->submit_form(
+        fields => {
+            map { $_ => $args{$_} }
+              grep { exists $args{$_} }
+              qw/comment summary status owner merge_into cc blocked_on/
+        }
+    );
+
+    if (
+        $self->html_tree_contains(
+            html      => $self->mech->content,
+            look_down => [ class => 'notice' ],
+            as_text   => qr/has been updated/,
+        )
+      )
+    {
+        $self->load( $self->id ); # maybe this is too much?
+        return 1;
+    }
+    else {
+        warn 'update failed';
+        return;
+    }
+}
+
+
 no Moose;
 __PACKAGE__->meta->make_immutable;
 
@@ -172,6 +289,12 @@
 
 =item summary
 
+=item create
+comment, summary, status, owner, cc, labels, files.
+
+=item update
+comment, summary, status, owner, merge_into, cc, labels, blocked_on, files.
+
 =item description
 
 =item labels

Modified: Net-Google-Code/trunk/lib/Net/Google/Code/Issue/Attachment.pm
==============================================================================
--- Net-Google-Code/trunk/lib/Net/Google/Code/Issue/Attachment.pm	(original)
+++ Net-Google-Code/trunk/lib/Net/Google/Code/Issue/Attachment.pm	Thu May 14 22:50:28 2009
@@ -1,6 +1,6 @@
 package Net::Google::Code::Issue::Attachment;
 use Moose;
-with 'Net::Google::Code::Role::Fetchable';
+with 'Net::Google::Code::Role::Fetchable', 'Net::Google::Code::Role::HTMLTree';
 use Scalar::Util qw/blessed/;
 
 has 'name'    => ( isa => 'Str', is => 'rw' );

Modified: Net-Google-Code/trunk/lib/Net/Google/Code/Issue/Comment.pm
==============================================================================
--- Net-Google-Code/trunk/lib/Net/Google/Code/Issue/Comment.pm	(original)
+++ Net-Google-Code/trunk/lib/Net/Google/Code/Issue/Comment.pm	Thu May 14 22:50:28 2009
@@ -1,6 +1,7 @@
 package Net::Google::Code::Issue::Comment;
 use Moose;
 use Net::Google::Code::Issue::Attachment;
+with 'Net::Google::Code::Role::HTMLTree';
 
 has 'updates' => ( isa => 'HashRef', is => 'rw', default => sub { {} } );
 has 'author'  => ( isa => 'Str',     is => 'rw' );

Modified: Net-Google-Code/trunk/lib/Net/Google/Code/Issue/Search.pm
==============================================================================
--- Net-Google-Code/trunk/lib/Net/Google/Code/Issue/Search.pm	(original)
+++ Net-Google-Code/trunk/lib/Net/Google/Code/Issue/Search.pm	Thu May 14 22:50:28 2009
@@ -3,7 +3,8 @@
 use Params::Validate qw(:all);
 use Moose::Util::TypeConstraints;
 with 'Net::Google::Code::Role::URL',
-  'Net::Google::Code::Role::Fetchable', 'Net::Google::Code::Role::Pageable';
+  'Net::Google::Code::Role::Fetchable', 'Net::Google::Code::Role::Pageable',
+  'Net::Google::Code::Role::HTMLTree';
 
 has 'project' => (
     isa      => 'Str',

Added: Net-Google-Code/trunk/lib/Net/Google/Code/Role/Authentication.pm
==============================================================================
--- (empty file)
+++ Net-Google-Code/trunk/lib/Net/Google/Code/Role/Authentication.pm	Thu May 14 22:50:28 2009
@@ -0,0 +1,121 @@
+package Net::Google::Code::Role::Authentication;
+use Moose::Role;
+
+with 'Net::Google::Code::Role::Fetchable';
+
+has 'email' => (
+    isa => 'Str',
+    is  => 'rw',
+);
+
+has 'password' => (
+    isa => 'Str',
+    is  => 'rw',
+);
+
+sub sign_in {
+    my $self = shift;
+    return 1 if $self->signed_in;
+    $self->ask_password unless $self->password && length $self->password;
+
+    $self->mech->get('https://www.google.com/accounts/Login');
+
+    $self->mech->submit_form(
+        with_fields => {
+            Email  => $self->email,
+            Passwd => $self->password,
+        },
+    );
+
+    die 'sign in failed to google code'
+      unless $self->signed_in;
+
+    return 1;
+}
+
+sub sign_out {
+    my $self = shift;
+    $self->mech->get('https://www.google.com/accounts/Logout');
+
+    die 'sign out failed to google code'
+      unless $self->signed_in;
+
+    return 1;
+}
+
+sub ask_password {
+    my $self = shift;
+    while ( !defined $self->password or $self->password eq '' ) {
+        require Term::ReadPassword;
+        my $pass = Term::ReadPassword::read_password("password: ");
+        $self->password($pass);
+    }
+}
+
+sub signed_in {
+    my $self = shift;
+
+    my $html = $self->mech->content;
+    # remove lines of head, style and script
+    $html =~ s!<head>.*?</head>!!sg;
+    $html =~ s!<style.*?</style>!!sg;
+    $html =~ s!<script.*?</script>!!sg;
+
+    my @lines = split /\n/, $html;
+    my $signed_in;
+    my $line = 0;
+
+    # only check the first 30 lines or so in case user input of 'sign out'
+    # exists below
+    for ( @lines ) {
+        $signed_in = 1 if /sign out/i;
+        $line++;
+        last if $line == 30;
+    }
+    return $signed_in;
+}
+
+no Moose::Role;
+
+1;
+
+__END__
+
+=head1 NAME
+
+Net::Google::Code::Role::Authentication - 
+
+=head1 DESCRIPTION
+
+=head1 INTERFACE
+
+
+=head2 sign_in
+
+sign in
+
+=head2 sign_out
+
+sign out
+
+=head2 signed_in
+
+return 1 if already signed in, return undef elsewise.
+
+=head2 ask_password
+
+ask user to input password
+
+=head1 AUTHOR
+
+sunnavy  C<< <sunnavy at bestpractical.com> >>
+
+
+=head1 LICENCE AND COPYRIGHT
+
+Copyright 2008-2009 Best Practical Solutions.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+

Added: Net-Google-Code/trunk/lib/Net/Google/Code/Role/HTMLTree.pm
==============================================================================
--- (empty file)
+++ Net-Google-Code/trunk/lib/Net/Google/Code/Role/HTMLTree.pm	Thu May 14 22:50:28 2009
@@ -0,0 +1,101 @@
+package Net::Google::Code::Role::HTMLTree;
+use Moose::Role;
+
+use HTML::TreeBuilder;
+use Params::Validate qw(:all);
+use Scalar::Util qw/blessed/;
+
+sub html_tree {
+    my $self = shift;
+    my %args = validate( @_, { content => { type => SCALAR } } );
+    my $tree = HTML::TreeBuilder->new;
+    $tree->parse_content($args{content});
+    $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;
+
+    if ( blessed $args{html} ) {
+        $tree = $args{html};
+    }
+    else {
+        $tree = HTML::TreeBuilder->new;
+        $tree->parse_content( $args{html} );
+        $tree->elementify;
+    }
+
+    my $part = $tree;
+    if ( $args{look_down} ) {
+        ($part) = $tree->look_down( @{ $args{look_down} } );
+    }
+
+    return unless $part;
+
+    my $text = $part->as_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 Moose::Role;
+
+1;
+
+__END__
+
+=head1 NAME
+
+Net::Google::Code::Role::HTMLTree - 
+
+=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 at bestpractical.com> >>
+
+
+=head1 LICENCE AND COPYRIGHT
+
+Copyright 2008-2009 Best Practical Solutions.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+

Modified: Net-Google-Code/trunk/lib/Net/Google/Code/Wiki.pm
==============================================================================
--- Net-Google-Code/trunk/lib/Net/Google/Code/Wiki.pm	(original)
+++ Net-Google-Code/trunk/lib/Net/Google/Code/Wiki.pm	Thu May 14 22:50:28 2009
@@ -2,7 +2,8 @@
 
 use Moose;
 use Params::Validate qw(:all);
-with 'Net::Google::Code::Role::Fetchable', 'Net::Google::Code::Role::URL';
+with 'Net::Google::Code::Role::Fetchable', 'Net::Google::Code::Role::URL',
+  'Net::Google::Code::Role::HTMLTree';
 
 has 'project' => (
     isa      => 'Str',

Modified: Net-Google-Code/trunk/lib/Net/Google/Code/Wiki/Comment.pm
==============================================================================
--- Net-Google-Code/trunk/lib/Net/Google/Code/Wiki/Comment.pm	(original)
+++ Net-Google-Code/trunk/lib/Net/Google/Code/Wiki/Comment.pm	Thu May 14 22:50:28 2009
@@ -2,6 +2,7 @@
 
 use Moose;
 use Params::Validate qw(:all);
+with 'Net::Google::Code::Role::HTMLTree';
 
 has 'content' => (
     isa => 'Str',



More information about the Bps-public-commit mailing list