[Bps-public-commit] net-lighthouse branch, master, updated. 2607f7b87c385bfd81589fcc44d1ffb30af49579

[sunnavy at bestpractical.com]

The branch, master has been updated
       via  2607f7b87c385bfd81589fcc44d1ffb30af49579 (commit)
      from  a0672c2f5770bb67de1dc698f14e207d53cdb25b (commit)

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

- Log -----------------------------------------------------------------
commit 2607f7b87c385bfd81589fcc44d1ffb30af49579
Author: sunnavy <sunnavy at bestpractical.com>
Date:   Thu Aug 27 16:26:26 2009 +0800

    implement methods for bin

diff --git a/lib/Net/Lighthouse/Project/TicketBin.pm b/lib/Net/Lighthouse/Project/TicketBin.pm
index 1520d32..9d92f4e 100644
--- a/lib/Net/Lighthouse/Project/TicketBin.pm
+++ b/lib/Net/Lighthouse/Project/TicketBin.pm
@@ -22,6 +22,157 @@ has [qw/name query default/] => (
 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 . '/bins/'
+      . $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 = Net::Lighthouse::Util->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 create {
+    my $self = shift;
+    validate(
+        @_,
+        {
+            goals  => { type     => SCALAR },
+            title  => { type     => SCALAR },
+            due_on => { optional => 1, type => SCALAR },
+        }
+    );
+    my %args = @_;
+
+    for my $field (qw/goals title due_on/) {
+        next unless exists $args{$field};
+        $args{$field} = { content => $args{$field} };
+    }
+
+    my $xml = XMLout( { bin => \%args }, KeepRoot => 1);
+    my $ua = $self->ua;
+
+    my $url = $self->base_url . '/projects/' . $self->project_id . '/bins.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(
+        @_,
+        {
+            goals  => { optional => 1, type     => SCALAR },
+            title  => { optional => 1, type     => SCALAR },
+            due_on => { optional => 1, type => SCALAR },
+        }
+    );
+    my %args = @_;
+
+    for my $field (qw/goals title due_on/) {
+        next unless exists $args{$field};
+        $args{$field} = { content => $args{$field} };
+    }
+
+    my $xml = XMLout( { bin => \%args }, KeepRoot => 1);
+    my $ua = $self->ua;
+    my $url =
+        $self->base_url
+      . '/projects/'
+      . $self->project_id . '/bins/'
+      . $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 . '/bins/'
+      . $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 . '/bins.xml';
+    my $ua  = $self->ua;
+    my $res = $ua->get($url);
+    if ( $res->is_success ) {
+        my $ts = XMLin( $res->content, KeyAttr => [] )->{'ticket-bin'};
+        $ts = [ $ts ] unless ref $ts eq 'ARRAY';
+        return map {
+            my $t = Net::Lighthouse::Project::TicketBin->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;
+    }
+
+}
 
 1;
 

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