[Bps-public-commit] net-lighthouse branch, master, updated. 7beaf8b3488f4ba5c59c6c2767afb71dd04815da
sunnavy at bestpractical.com
sunnavy at bestpractical.com
Thu Aug 27 02:43:08 EDT 2009
The branch, master has been updated
via 7beaf8b3488f4ba5c59c6c2767afb71dd04815da (commit)
from 00bf5f43ec5ce79aecc74d3cd80f68b5c39a23ef (commit)
Summary of changes:
lib/Net/Lighthouse/Project/Changeset.pm | 131 +++++++++++++++++++++++++++++++
1 files changed, 131 insertions(+), 0 deletions(-)
- Log -----------------------------------------------------------------
commit 7beaf8b3488f4ba5c59c6c2767afb71dd04815da
Author: sunnavy <sunnavy at bestpractical.com>
Date: Thu Aug 27 14:43:04 2009 +0800
implement methods for changeset
diff --git a/lib/Net/Lighthouse/Project/Changeset.pm b/lib/Net/Lighthouse/Project/Changeset.pm
index 4f571dc..9eb66dc 100644
--- a/lib/Net/Lighthouse/Project/Changeset.pm
+++ b/lib/Net/Lighthouse/Project/Changeset.pm
@@ -22,6 +22,137 @@ has [qw/body title changes changed_at revision/] => (
no Any::Moose;
__PACKAGE__->meta->make_immutable;
+sub load {
+ my $self = shift;
+ validate_pos( @_, { type => SCALAR, regex => qr/^\d+$/ } );
+ my $revision = shift;
+ my $ua = $self->ua;
+ my $url =
+ $self->base_url
+ . '/projects/'
+ . $self->project_id . '/changesets/'
+ . $revision . '.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(
+ @_,
+ {
+ revision => { type => SCALAR },
+ body => { type => SCALAR },
+ title => { type => SCALAR },
+ changes => { type => SCALAR },
+ changed_at => { type => SCALAR },
+ }
+ );
+ my %args = @_;
+
+ for my $field (qw/revision body title changes changed_at/) {
+ next unless exists $args{$field};
+ $args{$field} = { content => $args{$field} };
+ }
+
+ my $xml = XMLout( { changeset => \%args }, KeepRoot => 1);
+ my $ua = $self->ua;
+
+ my $url = $self->base_url . '/projects/' . $self->project_id . '/changesets.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 delete {
+ my $self = shift;
+ my $ua = $self->ua;
+ my $url =
+ $self->base_url
+ . '/projects/'
+ . $self->project_id . '/changesets/'
+ . $self->revision . '.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 . '/changesets.xml';
+ my $ua = $self->ua;
+ my $res = $ua->get($url);
+ if ( $res->is_success ) {
+ my $ts = XMLin( $res->content, KeyAttr => [] )->{changeset};
+ $ts = [ $ts ] unless ref $ts eq 'ARRAY';
+ return map {
+ my $t = Net::Lighthouse::Project::Changeset->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 . '/changesets/new.xml';
+ my $res = $ua->get( $url );
+ if ( $res->is_success ) {
+ return Net::Lighthouse::Util->translate_from_xml( $res->content );
+ }
+ else {
+ die "try to get $url failed: "
+ . $res->status_line . "\n"
+ . $res->content;
+ }
+}
1;
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list