File Coverage

blib/lib/Net/Google/Code/Issue.pm

Criterion	Covered	Total	%
statement	136	308	44.1
branch	24	88	27.2
condition	3	30	10.0
subroutine	14	18	77.7
pod	8	8	100.0
total	185	452	40.9

package Net::Google::Code::Issue;
use Any::Moose;
use Params::Validate qw(:all);
with 'Net::Google::Code::TypicalRoles';
use Net::Google::Code::DateTime;
use Net::Google::Code::Issue::Comment;
use Net::Google::Code::Issue::Attachment;
use Scalar::Util qw/blessed/;

use Net::Google::Code::Issue::Util;
extends 'Net::Google::Code::Issue::Base';

# set this to true to enable hybrid load, create and update
our $USE_HYBRID;

use XML::FeedPP;

has 'id' => (
    isa      => 'Int',
    is       => 'rw',
);

has 'status' => (
    isa => 'Str',
    is  => 'rw',
);

has 'owner' => (
    isa => 'Str',
    is  => 'rw',
);

has 'cc' => (
    isa => 'Str',
    is  => 'rw',
);

has 'summary' => (
    isa => 'Str',
    is  => 'rw',
);

has 'reporter' => (
    isa => 'Str',
    is  => 'rw',
);

has 'reported' => (
    isa => 'DateTime',
    is  => 'rw',
);

has 'merged' => (
    isa => 'Int',
    is  => 'rw',
);

has 'stars' => (
    isa => 'Int',
    is  => 'rw',
);

has 'closed' => (
    isa => 'Str',
    is  => 'rw',
);

has 'description' => (
    isa => 'Str',
    is  => 'rw',
);

has 'labels' => (
    isa     => 'ArrayRef',
    is      => 'rw',
    default => sub { [] },
);

has 'comments' => (
    isa     => 'ArrayRef[Net::Google::Code::Issue::Comment]',
    is      => 'rw',
    default => sub { [] },
);

has 'attachments' => (
    isa     => 'ArrayRef[Net::Google::Code::Issue::Attachment]',
    is      => 'rw',
    default => sub { [] },
);

sub load {
    my $self = shift;
    my $id = shift || $self->id;
    die "current object doesn't have id and load() is not passed an id either"
      unless $id;

    if ($USE_HYBRID) {
        unless ( $self->{loaded_way}
            && $self->{loaded_way} eq 'api'
            && $id == $self->id )
        {
            my ($issue) = $self->list( id => $id );
            %$self = %$issue;
        }
        $self->{loaded_way} = 'hybrid';

        $self->load_comments;

        # here we do scraping to get stuff not can be seen from feeds
        my $content =
          $self->fetch( $self->base_url . "issues/detail?id=" . $id );
        return $self->parse_hybrid($content);
    }
    else {
        my $content =
          $self->fetch( $self->base_url . "issues/detail?id=" . $id );
        $self->id( $id );
        $self->{loaded_way} = 'scraping';
        return $self->parse($content);
    }
}

sub parse {
    my $self    = shift;
    my $tree    = shift;

    my $need_delete = not blessed $tree;
    $tree = $self->html_tree( html => $tree ) unless blessed $tree;

    # extract summary
    my ($summary) = $tree->look_down( class => 'h3' );
    $self->summary( $summary->as_text );

    # extract reporter, reported and description
    my $description = $tree->look_down( class => 'vt issuedescription' );
    my $author_tag = $description->look_down( class => "author" );
    $self->reporter( $author_tag->content_array_ref->[1]->as_text );
    $self->reported( Net::Google::Code::DateTime->new_from_string($author_tag->look_down( class => 'date' )->attr('title') ));


    my $text = $description->find_by_tag_name('pre')->as_text;
    $text =~ s/^\s+//;
    $text =~ s/\s+$//;
    $text =~ s/\r\n/\n/g;
    $self->description( $text );

    my $att_tag = $description->look_down( class => 'attachments' );
    my @attachments;
    @attachments =
      Net::Google::Code::Issue::Attachment->parse_attachments($att_tag)
      if $att_tag;
    $self->attachments( \@attachments );

    my ($meta) = $tree->look_down( id => 'issuemeta' );
    {

        # let's find stars
        my ($header) = $tree->look_down( id => 'issueheader' );
        if (   $header
            && $header->as_text =~ /(\d+) \w+ starred this issue/ )
        {
# the \w+ is person or people, I don't know if google will change that word
# some time, so just use \w+
            my $stars = $1;
            $self->stars($stars);
        }
    }

    my @meta = $meta->find_by_tag_name('tr');
    my @labels;
    for my $meta (@meta) {
        my ( $key, $value );
        if ( my $k = $meta->find_by_tag_name('th') ) {
            my $v         = $meta->find_by_tag_name('td');
            my $k_content = $k->content_array_ref->[0];
            while ( ref $k_content ) {
                $k_content = $k_content->content_array_ref->[0];
            }
            $key = $k_content;    # $key is like 'Status:#'
            $key =~ s/:.$//;      # s/:#$// doesn't work, no idea why
            $key = lc $key;

            if ($v) {
                $value = $v->as_text;
                $value =~ s/^\s+//;
                $value =~ s/\s+$//;
            }

            if ( $self->can( $key ) ) {
                if ( $key eq 'merged' && $value =~ /issue\s+(\d+)/ ) {
                    $value = $1;
                }
                $self->$key( $value );
            }
            else {
                warn "no idea where to keep $key";
            }
        }
        else {
            my $href = $meta->look_down( class => 'label' )->attr('href');
            if ( $href =~ /list\?q=label:(.+)/ ) {
                push @labels, $1;
            }
        }
    }
    $self->labels( \@labels );

    # extract comments
    my @comments_tag = $tree->look_down( class => 'vt issuecomment' );
    my @comments;
    for my $tag (@comments_tag) {
        next unless $tag->look_down( class => 'author' );
        my $comment =
          Net::Google::Code::Issue::Comment->new( project => $self->project );
        $comment->parse($tag);
        push @comments, $comment;
    }

    my $initial_comment = Net::Google::Code::Issue::Comment->new(
        project     => $self->project,
        sequence    => 0,
        date        => $self->reported,
        author      => $self->reporter,
        content     => $self->description,
        attachments => $self->attachments,
    );

    my @initial_labels = @{$self->labels};
    my %meta = map { $_ => 1 } qw/summary status cc owner/;
    for my $c ( reverse @comments ) {
        my $updates = $c->updates;
        for ( keys %meta ) {
            # once these changes, we can't know the inital value
            delete $meta{$_} if exists $updates->{$_};
        }
        if ( $updates->{labels} ) {
            my @labels = @{$updates->{labels}};
            for my $label (@labels) {
                if ( $label =~ /^-(.*)$/ ) {
                    unshift @initial_labels, $1;
                }
                else {
                    @initial_labels = grep { $_ ne $label } @initial_labels;
                }
            }
        }
    }

    $initial_comment->updates->{labels} = \@initial_labels;
    for ( keys %meta ) {
        $initial_comment->updates->{$_} = $self->$_;
    }

    unshift @comments, $initial_comment;

    $self->comments( \@comments );
    $tree->delete if $need_delete;
    return 1;
}

sub load_comments {
    my $self = shift;
    require Net::Google::Code::Issue::Comment;
    my $comment = Net::Google::Code::Issue::Comment->new(
        issue_id => $self->id,
        map { $_ => $self->$_ }
          grep { $self->$_ } qw/project email password token/
    );

    # $comment is for initial comment we will work out
    $self->comments( [ $comment, $comment->list ] );
}

sub parse_hybrid {
    my $self    = shift;
    my $tree    = shift;
    my $need_delete = not blessed $tree;
    $tree = $self->html_tree( html => $tree ) unless blessed $tree;

    my $description = $tree->look_down( class => 'vt issuedescription' );
    my $att_tag = $description->look_down( class => 'attachments' );
    my @attachments;
    @attachments =
      Net::Google::Code::Issue::Attachment->parse_attachments($att_tag)
      if $att_tag;
    $self->attachments( \@attachments );

    my ($meta) = $tree->look_down( id => 'issuemeta' );
    my @meta = $meta->find_by_tag_name('tr');
    my @labels;
    for my $meta (@meta) {

        my ( $key, $value );
        if ( my $k = $meta->find_by_tag_name('th') ) {
            my $v         = $meta->find_by_tag_name('td');
            my $k_content = $k->content_array_ref->[0];
            while ( ref $k_content ) {
                $k_content = $k_content->content_array_ref->[0];
            }
            $key = $k_content;    # $key is like 'Status:#'
            $key =~ s/:.$//;      # s/:#$// doesn't work, no idea why
            $key = lc $key;

            if ($v) {
                $value = $v->as_text;
                $value =~ s/^\s+//;
                $value =~ s/\s+$//;
            }
            if ( $self->can( $key ) ) {
                if ( $key eq 'merged' && $value =~ /issue\s+(\d+)/ ) {
                    $value = $1;
                }
                $self->$key( $value );
            }
            else {
                warn "no idea where to keep $key";
            }
        }
    }

    # extract comments
    my @comments_tag = $tree->look_down( class => 'vt issuecomment' );
    ( undef, my @comments ) = @{$self->comments};
    my $number = 1; # 0 is for initial comment
    for my $tag (@comments_tag) {
        next unless $tag->look_down( class => 'author' );
        my $comment = $self->comments->[$number++];
        $comment->parse_hybrid($tag);
    }

    my $initial_comment = Net::Google::Code::Issue::Comment->new(
        sequence    => 0,
        date        => $self->reported,
        author      => $self->reporter,
        content     => $self->description,
        attachments => $self->attachments,
        issue_id    => $self->id,
        map { $_ => $self->$_ }
          grep { $self->$_ } qw/project email password token/
    );

    my @initial_labels = @{$self->labels};
    my %meta = map { $_ => 1 } qw/summary status cc owner/;
    for my $c ( reverse @comments ) {
        my $updates = $c->updates;
        for ( keys %meta ) {
            # once these changes, we can't know the inital value
            delete $meta{$_} if exists $updates->{$_};
        }
        if ( $updates->{labels} ) {
            my @labels = @{$updates->{labels}};
            for my $label (@labels) {
                if ( $label =~ /^-(.*)$/ ) {
                    unshift @initial_labels, $1;
                }
                else {
                    @initial_labels = grep { $_ ne $label } @initial_labels;
                }
            }
        }
    }

    $initial_comment->updates->{labels} = \@initial_labels;
    for ( keys %meta ) {
        $initial_comment->updates->{$_} = $self->$_;
    }
    $self->comments->[0] = $initial_comment;
    $tree->delete if $need_delete;
    return 1;
}

sub _load_from_xml {
    my $self = shift;
    my $ref =
      Net::Google::Code::Issue::Util->translate_from_xml( shift,
        type => 'issue' );

    for my $k ( keys %$ref ) {
        if ( $self->can($k) ) {
            $self->{$k} = $ref->{$k};
        }
    }
    return $self;
}

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/,
        }
    );

    if ( $args{files} || !$USE_HYBRID) {
        $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">)}{};
            }
            $self->mech->update_html($html);
        }

        $self->mech->form_with_fields( 'comment', 'summary' );

        # leave labels alone unless there're labels.
        $self->mech->field( 'label', $args{labels} ) if $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;
        }
    }
    else {

        # we can use google's official api here
        my $author = $self->email;
        $author =~ s/@.*//;
        my %args = ( author => $author, @_ );

        my $xml =
          Net::Google::Code::Issue::Util->translate_to_xml( \%args,
            type => 'create' );
        my $ua = $self->ua;

        my $url     = $self->feeds_issues_url . '/full';
        my $request = HTTP::Request->new( 'POST', $url, undef, $xml );
        my $res     = $ua->request($request);
        if ( $res->is_success ) {
            my $content = $res->content;

            # let's fake wrap the entry with
            $content =~ s!
            $content =~ s{$}{};
            my $feed = XML::FeedPP->new($content);
            my ($item) = $feed->get_item;
            $self->_load_from_xml($item);
            $self->load( $self->id );
            return 1;
        }
        else {
            die "try to POST $url failed: "
              . $res->status_line . "\n"
              . $res->content;
        }

    }
}

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/,
        }
    );

    if (   $args{files}
        || $args{merge_into}
        || $args{blocked_on}
        || !$USE_HYBRID )
    {

        $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">)}{};
            }
            $self->mech->update_html($html);
        }

        $self->mech->form_with_fields( 'comment', 'summary' );

        # leave labels alone unless there're labels.
        $self->mech->field( 'label', $args{labels} ) if $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;
        }
    }
    else {
        my $author = $self->email;
        $author =~ s/@.*//;
        my %args = (
            author => $author,
            (
                map { $_ => $self->$_ } qw/title content status owner cc labels/
            ),
            @_,
        );

        my $xml =
          Net::Google::Code::Issue::Util->translate_to_xml( \%args,
            type => 'update' );
        my $ua  = $self->ua;
        my $url = $self->feeds_issues_url . '/' . $self->id . '/comments/full';

        my $request = HTTP::Request->new( 'POST', $url, undef, $xml );
        my $res = $ua->request($request);
        if ( $res->is_success ) {
            $self->load( $self->id );    # let's reload
            return 1;
        }
        else {
            die "try to POST $url failed: "
              . $res->status_line . "\n"
              . $res->content;
        }

    }
}

sub updated {
    my $self = shift;
    my $last_comment = $self->comments->[-1];
    return $last_comment ? $last_comment->date : undef;
}

sub list {
    my $self = shift;
    validate(
        @_,
        {
            q             => { optional => 1, type => SCALAR },
            can           => { optional => 1, type => SCALAR },
            author        => { optional => 1, type => SCALAR },
            id            => { optional => 1, type => SCALAR },
            label         => { optional => 1, type => SCALAR },
            max_results   => { optional => 1, type => SCALAR },
            owner         => { optional => 1, type => SCALAR },
            published_min => { optional => 1, type => SCALAR },
            published_max => { optional => 1, type => SCALAR },
            updated_min   => { optional => 1, type => SCALAR },
            updated_max   => { optional => 1, type => SCALAR },
            start_index   => { optional => 1, type => SCALAR },
        }
    );

    my %args = @_;
    my $url = $self->feeds_issues_url . '/full?';
    require URI::Escape;
    for my $k ( keys %args ) {
        next unless $args{$k};
        my $v = $args{$k};
        $k =~ s/_/-/g;
        $url .= "$k=" . URI::Escape::uri_escape($v) . '&';
    }

    my $ua  = $self->ua;
    my $res = $ua->get($url);
    if ( $res->is_success ) {
        my $feed = XML::FeedPP->new($res->content);
        my @items = $feed->get_item;
        my @list = map {
            my $t = Net::Google::Code::Issue->new(
                loaded_way => 'api',
                map { $_ => $self->$_ }
                  grep { $self->$_ } qw/project email password token/
            );
            $t->_load_from_xml($_);
        } @items;
        return wantarray ? @list : \@list;
    }
    else {
        die "try to get $url failed: "
          . $res->status_line . "\n"
          . $res->content;
    }
}

no Any::Moose;
__PACKAGE__->meta->make_immutable;

1;

__END__