[Bps-public-commit] net-lighthouse branch, master, updated. 8e4352673ff0bea69316fa040b9b8d6e7ba469af

[sunnavy at bestpractical.com]

The branch, master has been updated
       via  8e4352673ff0bea69316fa040b9b8d6e7ba469af (commit)
      from  059db4badac427856919559443a09d2f3e026341 (commit)

Summary of changes:
 lib/Net/Lighthouse/Project/Message.pm |  236 +++++++++++++++++++++++++++++++++
 1 files changed, 236 insertions(+), 0 deletions(-)

- Log -----------------------------------------------------------------
commit 8e4352673ff0bea69316fa040b9b8d6e7ba469af
Author: sunnavy <sunnavy at bestpractical.com>
Date:   Thu Aug 27 16:03:57 2009 +0800

    implemnt methods for message

diff --git a/lib/Net/Lighthouse/Project/Message.pm b/lib/Net/Lighthouse/Project/Message.pm
index d86b22c..a458be1 100644
--- a/lib/Net/Lighthouse/Project/Message.pm
+++ b/lib/Net/Lighthouse/Project/Message.pm
@@ -32,6 +32,242 @@ has [qw/title body/] => (
 no Any::Moose;
 __PACKAGE__->meta->make_immutable;
 
+sub load {
+    my $self = shift;
+    validate_pos( @_, { type => SCALAR, regex => qr/^\d+$/ } );
+    my $id = shift;
+    my $ua = $self->ua;
+    my $url =
+        $self->base_url
+      . '/projects/'
+      . $self->project_id . '/messages/'
+      . $id . '.xml';
+    my $res = $ua->get( $url );
+    if ( $res->is_success ) {
+        $self->load_from_xml( $res->content );
+    }
+    else {
+        die "try to get $url failed: "
+          . $res->status_line . "\n"
+          . $res->content;
+    }
+}
+
+sub load_from_xml {
+    my $self = shift;
+    my $ref = $self->_translate_from_xml( shift );
+
+    # dirty hack: some attrs are read-only, and Mouse doesn't support
+    # writer => '...'
+    for my $k ( keys %$ref ) {
+        $self->{$k} = $ref->{$k};
+    }
+    return $self;
+}
+
+sub _translate_from_xml {
+    my $self = shift;
+    my $ref = Net::Lighthouse::Util->translate_from_xml( shift );
+    for my $k ( keys %$ref ) {
+        if ( $k eq 'comments' ) {
+            # if has parent_id, then it's comment, comment can't have comments
+            if ( $ref->{parent_id} ) {
+                delete $ref->{comments};
+                next;
+            }
+
+            if ( $ref->{comments} ) {
+                my $comments = $ref->{comments}{comment};
+                $ref->{comments} = [
+                    map {
+                        my $v = Net::Lighthouse::Project::Message->new;
+                        $v->load_from_xml($_)
+                      } @$comments
+                ];
+            }
+            else {
+                $ref->{comments} = [];
+            }
+        }
+    }
+    return $ref;
+}
+
+sub create {
+    my $self = shift;
+    validate(
+        @_,
+        {
+            title => { type     => SCALAR },
+            body  => { type     => SCALAR },
+        }
+    );
+    my %args = @_;
+
+    for my $field (qw/title body/) {
+        next unless exists $args{$field};
+        $args{$field} = { content => $args{$field} };
+    }
+
+    my $xml = XMLout( { message => \%args }, KeepRoot => 1);
+    my $ua = $self->ua;
+
+    my $url = $self->base_url . '/projects/' . $self->project_id . '/messages.xml';
+
+    my $request = HTTP::Request->new( 'POST', $url, undef, $xml );
+    my $res = $ua->request( $request );
+    if ( $res->is_success ) {
+        $self->load_from_xml( $res->content );
+        return 1;
+    }
+    else {
+        die "try to POST $url failed: "
+          . $res->status_line . "\n"
+          . $res->content;
+    }
+}
+
+sub create_comment {
+    my $self = shift;
+    validate(
+        @_,
+        {
+            body  => { type     => SCALAR },
+        }
+    );
+    my %args = @_;
+
+    for my $field (qw/body/) {
+        next unless exists $args{$field};
+        $args{$field} = { content => $args{$field} };
+    }
+
+    # doc says <message>, but it doesn't work actually.
+    # comment can work, though still with a problem
+    my $xml = XMLout( { comment => \%args }, KeepRoot => 1);
+    my $ua = $self->ua;
+
+    my $url =
+        $self->base_url
+      . '/projects/'
+      . $self->project_id
+      . '/messages/'
+      . $self->id
+      . '/comments.xml';
+
+    my $request = HTTP::Request->new( 'POST', $url, undef, $xml );
+    my $res = $ua->request( $request );
+
+    if ( $res->is_success ) {
+        $self->load_from_xml( $res->content );
+        return 1;
+    }
+    else {
+        die "try to POST $url failed: "
+          . $res->status_line . "\n"
+          . $res->content;
+    }
+}
+
+sub update {
+    my $self = shift;
+    validate(
+        @_,
+        {
+            title => { optional => 1, type     => SCALAR },
+            body  => { optional => 1, type     => SCALAR },
+        }
+    );
+    my %args = @_;
+
+    for my $field (qw/title body/) {
+        next unless exists $args{$field};
+        $args{$field} = { content => $args{$field} };
+    }
+
+    my $xml = XMLout( { message => \%args }, KeepRoot => 1);
+    my $ua = $self->ua;
+    my $url =
+        $self->base_url
+      . '/projects/'
+      . $self->project_id . '/messages/'
+      . $self->id . '.xml';
+
+    my $request = HTTP::Request->new( 'PUT', $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 PUT $url failed: "
+          . $res->status_line . "\n"
+          . $res->content;
+    }
+}
+
+sub delete {
+    my $self = shift;
+    my $ua = $self->ua;
+    my $url =
+        $self->base_url
+      . '/projects/'
+      . $self->project_id . '/messages/'
+      . $self->id . '.xml';
+
+    my $request = HTTP::Request->new( 'DELETE', $url );
+    my $res = $ua->request( $request );
+    if ( $res->is_success ) {
+        return 1;
+    }
+    else {
+        die "try to DELETE $url failed: "
+          . $res->status_line . "\n"
+          . $res->content;
+    }
+}
+
+sub list {
+    my $self = shift;
+    my $url =
+      $self->base_url . '/projects/' . $self->project_id . '/messages.xml';
+
+    my $ua  = $self->ua;
+    my $res = $ua->get($url);
+    if ( $res->is_success ) {
+        my $ts = XMLin( $res->content, KeyAttr => [] )->{message};
+        $ts = [ $ts ] unless ref $ts eq 'ARRAY';
+        return map {
+            my $t = Net::Lighthouse::Project::Message->new(
+                map { $_ => $self->$_ }
+                  grep { $self->$_ } qw/account email password token project_id/
+            );
+            $t->load_from_xml($_);
+        } @$ts;
+    }
+    else {
+        die "try to get $url failed: "
+          . $res->status_line . "\n"
+          . $res->content;
+    }
+
+}
+
+sub initial_state {
+    my $self = shift;
+    my $ua = $self->ua;
+    my $url =
+      $self->base_url . '/projects/' . $self->project_id . '/messages/new.xml';
+    my $res = $ua->get( $url );
+    if ( $res->is_success ) {
+        return $self->_translate_from_xml( $res->content );
+    }
+    else {
+        die "try to get $url failed: "
+          . $res->status_line . "\n"
+          . $res->content;
+    }
+}
 
 1;
 

-----------------------------------------------------------------------