Mercurial > pub > buggler
changeset 7:29309bc8d932
initial objects to work with bugzilla web service
author | cin |
---|---|
date | Fri, 04 Sep 2015 19:41:28 +0300 |
parents | 2a5f38eb25a9 |
children | ff9c0c788382 |
files | .includepath lib/Benzin/Bugzilla/Bug.pm lib/Benzin/Bugzilla/BugComment.pm lib/Benzin/Bugzilla/XmlRpcClient.pm translate.pl |
diffstat | 5 files changed, 175 insertions(+), 90 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/.includepath Fri Sep 04 19:41:28 2015 +0300 @@ -0,0 +1,6 @@ +<?xml version="1.0" encoding="UTF-8"?> +<includepath> + <includepathentry path="${resource_loc:/buggler/lib}" /> + <includepathentry path="${resource_loc:/Impl/lib}" /> +</includepath> +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/Benzin/Bugzilla/Bug.pm Fri Sep 04 19:41:28 2015 +0300 @@ -0,0 +1,67 @@ +package Benzin::Bugzilla::Bug; +use strict; + +my @bugFields; + +BEGIN { + @bugFields = qw( + id + summary + creation_time + last_change_time + creator + assigned_to + qa_contact + cc + + status + resolution + + priority + severity + url + + blocks + depends_on + + + component + product + classification + version + + actual_time + estimated_time + remaining_time + deadline + + comments + ); +} + +use constant { + BUG_FIELDS => \@bugFields +}; + +use IMPL::declare { + base => [ + 'IMPL::Object::Fields' => undef + ] +}; + +use fields @bugFields; + +sub CTOR { + my SELF $this = shift; + my $data = shift; + + $this->{$_} = $data->{$_} foreach grep exists $data->{$_}, SELF->BUG_FIELDS; +} + +sub GetEffort { + my SELF $this = shift; + + return $this->{actual_time} + $this->{remaining_time}; +} + +1;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/Benzin/Bugzilla/BugComment.pm Fri Sep 04 19:41:28 2015 +0300 @@ -0,0 +1,32 @@ +package Benzin::Bugzilla::BugComment; +use strict; + +my @fields; + +BEGIN { + @fields = qw( + id + ); +} + +use constant { + BUG_FIELDS => \@fields +}; + +use IMPL::declare { + base => [ + 'IMPL::Object::Fields' => undef + ] +}; + +use fields @fields; + +sub CTOR { + my SELF $this = shift; + my $data = shift; + + $this->{$_} = $data->{$_} foreach grep exists $data->{$_}, SELF->BUG_FIELDS; +} + + +1;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/Benzin/Bugzilla/XmlRpcClient.pm Fri Sep 04 19:41:28 2015 +0300 @@ -0,0 +1,70 @@ +package Benzin::Bugzilla::XmlRpcClient; +use strict; + +use LWP::UserAgent; +use XMLRPC::Lite; +use YAML::XS qw(Dump); + +use IMPL::require { + Bug => 'Benzin::Bugzilla::Bug' +}; + +use fields qw(url apikey); + +use constant { SELF => __PACKAGE__ }; + +sub new { + my $class = shift; + $class = ref $class || $class; + + my $inst = fields::new($class); + $inst->CTOR(@_); + + return $inst; +} + +sub CTOR { + my SELF $this = shift; + my %params = @_; + + $this->{url} = $params{url} or die "An url is required"; + $this->{apikey} = $params{apikey} if $params{apikey}; +} + +sub GetBugs { + my SELF $this = shift; + + return [map Bug->new($_), @{$this->_CallService( 'Bug.get', shift )->{bugs} || [] }]; +} + +sub FillBugComments { + my SELF $this = shift; + my $bugs = shift || []; + + if ( my @ids = map $_->{id}, @$bugs ) { + + my $comments = $this->_CallService( 'Bug.comments', { ids => \@ids } ); + + for my Bug $bug (@$bugs) { + map @{$comments->{$bug->{id}}->{comments} || [] }; + } + } +} + +sub _CallService { + my SELF $this = shift; + my ( $method, $params ) = @_; + + die "Method must be specified" unless $method; + $params ||= {}; + + $params->{api_key} = $this->{apikey}; + my $url = URI->new_abs( 'xmlrpc.cgi', $this->{url} ); + + my $result = XMLRPC::Lite->proxy($url)->call( $method, $params ); + + die $result->fault if $result->fault; + return $result->result; +} + +1;
--- a/translate.pl Wed Sep 02 20:43:38 2015 +0300 +++ b/translate.pl Fri Sep 04 19:41:28 2015 +0300 @@ -122,99 +122,9 @@ close HIN; finish($proc); -#xalan( -# in => \*OUT, -# out => \*STDOUT, -# params => [ -# -# ] -#); - -sub xalan { - my @params = @_; - return system 'java', - -cp => join( ':', @ClassPath ), - "org.apache.xalan.xslt.Process", @params; -} - package BzRest; -use fields qw(url apikey); -use LWP::UserAgent; -use XMLRPC::Lite; -use YAML::XS qw(Dump); - -use constant { SELF => __PACKAGE__ }; - -sub new { - my $class = shift; - $class = ref $class || $class; - - my $inst = fields::new($class); - $inst->CTOR(@_); - - return $inst; -} - -sub CTOR { - my SELF $this = shift; - my %params = @_; - - $this->{url} = $params{url} or die "An url is required"; - $this->{apikey} = $params{apikey} if $params{apikey}; -} - -sub GetBug { - my SELF $this = shift; - my $id = shift; - my %params = @_; - $params{api_key} = $this->{apikey}; - my $bugurl = URI->new_abs( 'rest/bug/' . $id, $this->{url} ); - $bugurl->query_form( \%params ); - - my $agent = LWP::UserAgent->new(); - my $res = $agent->get($bugurl); - - return $this->_AssertResponse( $res, $bugurl ); -} - -sub GetBugs { - my SELF $this = shift; - - return $this->CallXMLRPC( 'Bug.get', shift )->{bugs}; -} - -sub CallXMLRPC { - my SELF $this = shift; - my ( $method, $params ) = @_; - - die "Method must be specified" unless $method; - $params ||= {}; - - $params->{api_key} = $this->{apikey}; - my $url = URI->new_abs( 'xmlrpc.cgi', $this->{url} ); - - my $result = XMLRPC::Lite->proxy($url)->call( $method, $params ); - - die $result->fault if $result->fault; - return $result->result; -} - -sub _AssertResponse { - my SELF $this = shift; - my ( $res, $url ) = @_; - - die "Failed to get any response: " . $url unless $res; - - die "Failed to fetch: " . $url . ": " . $res->code unless $res->is_success; - - my $bug = JSON->new()->utf8()->decode( $res->content ); - - die "Bugzilla failed: " . $bug->{message} if $bug->{error}; - - return $bug->{bugs}; -} __END__