Mercurial > pub > buggler

changeset 9:cc7244ab1b9f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
implemented time reports on bugs
author cin
date Sat, 05 Sep 2015 22:01:12 +0300
parents ff9c0c788382
children 14a966369278
files lib/Benzin/Bugzilla/Bug.pm lib/Benzin/Bugzilla/BugComment.pm lib/Benzin/Bugzilla/XmlRpcClient.pm lib/Benzin/Bugzilla/XmlSerializer.pm translate.pl
diffstat 5 files changed, 228 insertions(+), 160 deletions(-) [+]
line wrap: on
line diff
--- a/lib/Benzin/Bugzilla/Bug.pm	Fri Sep 04 19:42:15 2015 +0300
+++ b/lib/Benzin/Bugzilla/Bug.pm	Sat Sep 05 22:01:12 2015 +0300
@@ -1,10 +1,13 @@
 package Benzin::Bugzilla::Bug;
 use strict;
+use POSIX;
+use Scalar::Util qw(looks_like_number);
+use DateTime;
 
-my @bugFields;
+my @fields;
 
 BEGIN {
-	@bugFields = qw(
+	@fields = qw(
 	  id
 	  summary
 	  creation_time
@@ -14,6 +17,7 @@
 	  qa_contact
 	  cc
 
+	  is_open
 	  status
 	  resolution
 
@@ -23,7 +27,6 @@
 
 	  blocks
 	  depends_on
-	  
 
 	  component
 	  product
@@ -34,34 +37,92 @@
 	  estimated_time
 	  remaining_time
 	  deadline
-	  
+
 	  comments
+	  history
 	);
 }
 
-use constant {
-	BUG_FIELDS => \@bugFields
-};
+use constant { BUG_FIELDS => \@fields };
 
 use IMPL::declare {
+	require => {
+		Strptime => 'DateTime::Format::Strptime'
+	},
 	base => [
-	   'IMPL::Object::Fields' => undef
+		'IMPL::Object::Fields' => undef
 	]
 };
 
-use fields @bugFields;
+use fields @fields;
+
+my $dtparser = Strptime->new(
+	pattern => '%Y%m%dT%H:%M:%S',
+	time_zone => 'UTC',
+	on_error => 'croak'
+);
 
 sub CTOR {
 	my SELF $this = shift;
-    my $data = shift;
-    
-    $this->{$_} = $data->{$_} foreach grep exists $data->{$_}, SELF->BUG_FIELDS;
+	my $data = shift;
+	$this->{$_} = $data->{$_}
+	  foreach grep exists $data->{$_}, @{ SELF->BUG_FIELDS };
 }
 
-sub GetEffort {
+# returns {
+#	reports => [
+#		{ who => email:string, when => report-date-time:DateTime, work_time => hours:double }
+#	],
+#   actual => hours
+#	remaining => hours
+# }
+sub GetTimeReports {
 	my SELF $this = shift;
+	my $resolution = shift || 0.25;
 	
-    return $this->{actual_time} + $this->{remaining_time};
+	warn "Processing: $this->{id}";
+
+	my @bookings;
+	my $actual = 0;
+
+	for my $history ( @{ $this->{history} || [] } ) {
+		my $who     = $history->{who};
+		warn $history->{when};
+		my $when    = $dtparser->parse_datetime( $history->{when} );
+		my $changes = $history->{changes};
+
+		for my $change ( @{ $changes || [] } ) {
+			if ( $change->{field_name} eq 'work_time' ) {
+				my $prev  = $change->{removed} || 0;
+				my $value = $change->{added}   || 0;
+				if ( looks_like_number($prev) and looks_like_number($value) ) {
+					my $dt = coarsen( $value - $prev, $resolution );
+
+					if ($dt) {
+						push @bookings,
+						  {
+							who       => $who,
+							when      => $when->iso8601(),
+							work_time => $dt,
+							start     => $when->clone()->subtract( hours => $dt )->iso8601()
+						  };
+						$actual += $dt;
+					}
+				}
+			}
+		}
+	}
+
+	return {
+		reports   => \@bookings,
+		actual    => $actual,
+		remaining => coarsen( $this->{remaining_time}, $resolution )
+	};
 }
 
-1;
+sub coarsen {
+	my ( $value, $resolution ) = @_;
+	return $resolution ? ceil( $value / $resolution ) * $resolution : $value;
+}
+
+1;
\ No newline at end of file
--- a/lib/Benzin/Bugzilla/BugComment.pm	Fri Sep 04 19:42:15 2015 +0300
+++ b/lib/Benzin/Bugzilla/BugComment.pm	Sat Sep 05 22:01:12 2015 +0300
@@ -4,37 +4,35 @@
 my @fields;
 
 BEGIN {
-    @fields = qw(
-      id
-      bug_id
-      attachment_id
-      count
-      text
-      creator
-      creation_time
-      is_private
-      is_markdown
-    );
+	@fields = qw(
+	  id
+	  bug_id
+	  attachment_id
+	  count
+	  text
+	  creator
+	  creation_time
+	  is_private
+	  is_markdown
+	);
 }
 
-use constant {
-    BUG_FIELDS => \@fields
-};
+use constant { COMMENT_FIELDS => \@fields };
 
 use IMPL::declare {
-    base => [
-       'IMPL::Object::Fields' => undef
-    ]
+	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;
+	my SELF $this = shift;
+	my $data = shift;
+
+	$this->{$_} = $data->{$_}
+	  foreach grep exists $data->{$_}, @{ SELF->COMMENT_FIELDS };
 }
 
-
 1;
--- a/lib/Benzin/Bugzilla/XmlRpcClient.pm	Fri Sep 04 19:42:15 2015 +0300
+++ b/lib/Benzin/Bugzilla/XmlRpcClient.pm	Sat Sep 05 22:01:12 2015 +0300
@@ -5,14 +5,16 @@
 use XMLRPC::Lite;
 use YAML::XS qw(Dump);
 
-use IMPL::require {
-	Bug => 'Benzin::Bugzilla::Bug'
+use IMPL::declare {
+	require => {
+		Bug        => 'Benzin::Bugzilla::Bug',
+		BugComment => 'Benzin::Bugzilla::BugComment'
+	},
+	base => { 'IMPL::Object::Fields' => undef }
 };
 
 use fields qw(url apikey);
 
-use constant { SELF => __PACKAGE__ };
-
 sub new {
 	my $class = shift;
 	$class = ref $class || $class;
@@ -34,21 +36,47 @@
 sub GetBugs {
 	my SELF $this = shift;
 
-	return [map Bug->new($_), @{$this->_CallService( 'Bug.get', shift )->{bugs} || [] }];
+	return [
+		map Bug->new($_),
+		@{ $this->_CallService( 'Bug.get', shift )->{bugs} || [] }
+	];
 }
 
-sub FillBugComments {
+sub PopulateBugsWithComments {
 	my SELF $this = shift;
 	my $bugs = shift || [];
 
 	if ( my @ids = map $_->{id}, @$bugs ) {
 
-		my $comments = $this->_CallService( 'Bug.comments', { ids => \@ids } );
-		
+		my $resp = $this->_CallService( 'Bug.comments', { ids => \@ids } );
+
 		for my Bug $bug (@$bugs) {
-			map   @{$comments->{$bug->{id}}->{comments} || [] };
+			$bug->{comments} = [
+				map BugComment->new($_),
+				@{ $resp->{bugs}{ $bug->{id} }->{comments} || [] }
+			];
 		}
 	}
+	return;
+}
+
+sub PopulateBugsHistory {
+	my SELF $this = shift;
+
+	my %bugs = map { $_->{id}, $_ } @{ shift || [] };
+
+	if ( keys %bugs ) {
+
+		my $resp =
+		  $this->_CallService( 'Bug.history', { ids => [ keys %bugs ] } )->{bugs};
+
+		for my $data (@$resp) {
+			my Bug $bug = $bugs{$data->{id}};
+			
+			$bug->{history} = $data->{history};
+		}
+	}
+	return;
 }
 
 sub _CallService {
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/Benzin/Bugzilla/XmlSerializer.pm	Sat Sep 05 22:01:12 2015 +0300
@@ -0,0 +1,67 @@
+package Benzin::Bugzilla::XmlSerializer;
+
+use IMPL::declare {
+	require => {
+		XMLWriter => 'XML::Writer'
+	},
+	base => [
+		'IMPL::Object::Fields' => undef
+	]
+};
+
+use fields qw(_writer);
+
+sub CTOR {
+	my SELF $this = shift;
+	
+	$this->{_writer} = XMLWriter->new(@_);
+}
+
+sub WriteBugList {
+	my SELF $this = shift;
+	my $bugs = shift || [];
+	my $writer = $this->{_writer};
+	
+	
+	$writer->xmlDecl("UTF-8");
+	$writer->startTag("bugzilla");
+	
+	$writer->startElement("bugs");
+	
+	$this->WriteBug($_) foreach @$bugs;
+	
+	$writer->endTag();
+	$writer->endTag();
+	
+}
+
+sub WriteBug {
+	my SELF $this = shift;
+	my $bug       = shift;
+	my $writer    = $this->{_writer};
+
+	$writer->startTag("bug");
+	foreach my $field ( @{ Bug->BUG_FIELDS } ) {
+		next unless $bug->{$field};
+		$this->WriteElement( $field, $bug->{$field} );
+	}
+	$writer->endTag();
+}
+
+sub WriteElement {
+	my SELF $this = shift;
+	my ( $name, $data ) = @_;
+	my $writer = $this->{_writer};
+
+	my @values =
+	     ref($data)
+	  && ref($data) eq 'ARRAY'
+	  ? @{$data}
+	  : $data;
+
+	foreach my $v (@values) {
+		$writer->dataElement( $name, $v );
+	}
+}
+
+1;
--- a/translate.pl	Fri Sep 04 19:42:15 2015 +0300
+++ b/translate.pl	Sat Sep 05 22:01:12 2015 +0300
@@ -1,8 +1,10 @@
 #!/usr/bin/perl -w
 
-use JSON;
+use IMPL::require {
+	BzClient => 'Benzin::Bugzilla::XmlRpcClient',
+	Bug      => 'Benzin::Bugzilla::Bug'
+};
 use YAML::XS qw(LoadFile Dump);
-use URI;
 use XML::Writer;
 use IPC::Run qw(start finish);
 
@@ -20,138 +22,50 @@
 	$config->{bugzilla}{url} .= "/";
 }
 
-my $bz = BzRest->new(
+my $bz = BzClient->new(
 	url    => $config->{bugzilla}{url},
 	apikey => $config->{bugzilla}{apikey}
 );
 
-my @fields = qw(
-  id
-  summary
-  creation_time
-  last_change_time
-  creator
-  assigned_to
-
-  status
-  resolution
-
-  priority
-  severity
-  url
-
-  blocks
-  depends_on
-  cc
-
-  component
-  product
-  classification
-  version
-
-  actual_time
-  estimated_time
-  remainig_time
-  deadline
-);
-
-my %fieldsMap = (
-	summary          => 'short_desc',
-	id               => 'bug_id',
-	creator          => 'reporter',
-	status           => 'bug_status',
-	severity         => 'bug_severity',
-	blocks           => 'blocked',
-	depends_on       => 'dependson',
-	creation_time    => 'creation_ts',
-	last_change_time => 'delta_ts'
-);
-
 local (*HIN);
 
 my $proc = start( [ 'saxon8', '-novw', '-', 'bug-list.xsl' ],
 	'<pipe', \*HIN, '>', \*STDOUT )
   or die "failed to create pipe: $!";
 
-my $writer = XML::Writer->new( OUTPUT => \*HIN, ENCODING => 'utf-8' );
-
-$writer->xmlDecl("UTF-8");
-$writer->startTag("bugzilla");
-
-my %visited;
-my @queue = (283);
+eval {
+	my %visited;
+	my @queue = (283);
+	my @fetched;
 
-while (@queue) {
-	@queue = grep not( $visited{$_}++ ), @queue;
+	while (@queue) {
+		@queue = grep not( $visited{$_}++ ), @queue;
 
-	last unless @queue;
+		last unless @queue;
 
-	print "#Fetching: ", join( ', ', @queue ), "\n";
-
-	my $bugs = $bz->GetBugs( { ids => \@queue } );
+		print "#Fetching: ", join( ', ', @queue ), "\n";
 
-	@queue = ();
-
-	foreach my $bug (@$bugs) {
+		my $bugs = $bz->GetBugs( { ids => \@queue } );
+		@queue = ();
 
-		push @queue, @{ $bug->{depends_on} }
-		  if ( $bug->{depends_on} );
-
-		$writer->startTag("bug");
-		foreach my $field (@fields) {
-			next unless $bug->{$field};
+		foreach my $bug (@$bugs) {
 
-			my $tagName = $fieldsMap{$field} || $field;
-			my @values =
-			     ref( $bug->{$field} )
-			  && ref( $bug->{$field} ) eq 'ARRAY'
-			  ? @{ $bug->{$field} }
-			  : $bug->{$field};
+			push @queue, @{ $bug->{depends_on} }
+			  if ( $bug->{depends_on} );
+			push @fetched, $bug;
+		}
+	}
+	print Dump( \@fetched );
 
-			foreach my $v (@values) {
-				$writer->dataElement( $tagName, $v );
-			}
-		}
-		$writer->endTag();
+	$bz->PopulateBugsWithComments( \@fetched );
+	$bz->PopulateBugsHistory( \@fetched );
 
-	}
-}
+	print Dump( [ map $_->GetTimeReports(0.25), @fetched ] );
 
-$writer->endTag();
+};
+warn Dump($@) and die $@ if $@;
 
 close HIN;
 finish($proc);
 
-package BzRest;
-
-
-
-__END__
-
-=pod
-
-=head1 NAME
-
-C<translate.pl> - translates bugzilla xml buglist to TaskJuggler format
-
-=head1 METHODS
-
-=head2 xalan(%args)
-
-=over
-
-=item * -IN
-
-Input file
-
-=item * -OUT
-
-Output file
-
-=item * -XSL
-
-XSLT file
-
-=back
-
-=cut
+1;