[Bps-public-commit] r17543 - in Net-Trac/trunk: . lib/Net/Trac t
trs at bestpractical.com
trs at bestpractical.com
Sat Jan 3 13:29:15 EST 2009
Author: trs
Date: Sat Jan 3 13:29:13 2009
New Revision: 17543
Added:
Net-Trac/trunk/MANIFEST.SKIP
Net-Trac/trunk/META.yml
Modified:
Net-Trac/trunk/ (props changed)
Net-Trac/trunk/MANIFEST
Net-Trac/trunk/Makefile.PL
Net-Trac/trunk/TODO
Net-Trac/trunk/lib/Net/Trac.pm
Net-Trac/trunk/lib/Net/Trac/Connection.pm
Net-Trac/trunk/lib/Net/Trac/Mechanize.pm
Net-Trac/trunk/lib/Net/Trac/Ticket.pm
Net-Trac/trunk/lib/Net/Trac/TicketAttachment.pm
Net-Trac/trunk/lib/Net/Trac/TicketHistory.pm
Net-Trac/trunk/lib/Net/Trac/TicketHistoryEntry.pm
Net-Trac/trunk/lib/Net/Trac/TicketPropChange.pm
Net-Trac/trunk/lib/Net/Trac/TicketSearch.pm
Net-Trac/trunk/t/02-create.t
Net-Trac/trunk/t/50-full-api.t
Net-Trac/trunk/t/99-pod-coverage.t
Net-Trac/trunk/t/attachments.t
Net-Trac/trunk/t/comments.t
Net-Trac/trunk/t/parse_props.t
Net-Trac/trunk/t/search.t
Net-Trac/trunk/t/update.t
Log:
r43418 at zot: tom | 2009-01-03 13:28:57 -0500
- Every class now has complete documentation
- TicketSearch now supports multiple values and operators other than =
- New tests for ticket search updates
- Every test file has a plan
- Updated MANIFEST and META.yml
Modified: Net-Trac/trunk/MANIFEST
==============================================================================
--- Net-Trac/trunk/MANIFEST (original)
+++ Net-Trac/trunk/MANIFEST Sat Jan 3 13:29:13 2009
@@ -13,9 +13,11 @@
lib/Net/Trac/Connection.pm
lib/Net/Trac/Mechanize.pm
lib/Net/Trac/Ticket.pm
+lib/Net/Trac/TicketAttachment.pm
lib/Net/Trac/TicketHistory.pm
lib/Net/Trac/TicketHistoryEntry.pm
lib/Net/Trac/TicketPropChange.pm
+lib/Net/Trac/TicketSearch.pm
Makefile.PL
MANIFEST This list of files
META.yml
@@ -24,5 +26,9 @@
t/50-full-api.t
t/99-pod-coverage.t
t/99-pod.t
+t/attachments.t
+t/comments.t
t/parse_props.t
+t/search.t
t/setup_trac.pl
+t/update.t
Added: Net-Trac/trunk/MANIFEST.SKIP
==============================================================================
--- (empty file)
+++ Net-Trac/trunk/MANIFEST.SKIP Sat Jan 3 13:29:13 2009
@@ -0,0 +1 @@
+TODO
Added: Net-Trac/trunk/META.yml
==============================================================================
--- (empty file)
+++ Net-Trac/trunk/META.yml Sat Jan 3 13:29:13 2009
@@ -0,0 +1,29 @@
+---
+abstract: Interact with a remote Trac instance
+author:
+ - Jesse Vincent <jesse at bestpractical.com>, Thomas Sibley <trs at bestpractical.com>
+distribution_type: module
+generated_by: Module::Install version 0.70
+license: perl
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.3.html
+ version: 1.3
+name: Net-Trac
+no_index:
+ directory:
+ - inc
+ - t
+requires:
+ DateTime::Format::ISO8601: 0
+ IO::Scalar: 0
+ LWP::Simple: 0
+ Lingua::EN::Inflect: 0
+ Moose: 0
+ Moose::Util::TypeConstraints: 0
+ Params::Validate: 0
+ Text::CSV_XS: 0
+ URI: 0
+ URI::Escape: 0
+ WWW::Mechanize: 1.52
+ XML::Feed: 0
+version: 0.02
Modified: Net-Trac/trunk/Makefile.PL
==============================================================================
--- Net-Trac/trunk/Makefile.PL (original)
+++ Net-Trac/trunk/Makefile.PL Sat Jan 3 13:29:13 2009
@@ -17,6 +17,7 @@
requires 'WWW::Mechanize' => '1.52';
requires 'DateTime::Format::ISO8601';
requires 'Lingua::EN::Inflect';
+requires 'URI::Escape';
auto_install;
sign;
Modified: Net-Trac/trunk/TODO
==============================================================================
--- Net-Trac/trunk/TODO (original)
+++ Net-Trac/trunk/TODO Sat Jan 3 13:29:13 2009
@@ -1,12 +1,4 @@
-write perldoc!
-
we should really cache validation data in the Connection.
or just not use it at all
-review error handling -- esp. die on error usage in api
-
regex escape?
-
-grep for XXX TODO as well
-
-add test plans
Modified: Net-Trac/trunk/lib/Net/Trac.pm
==============================================================================
--- Net-Trac/trunk/lib/Net/Trac.pm (original)
+++ Net-Trac/trunk/lib/Net/Trac.pm Sat Jan 3 13:29:13 2009
@@ -1,31 +1,39 @@
+use strict;
+use warnings;
+
package Net::Trac;
use Moose;
-our $VERSION = '0.01_01';
+our $VERSION = '0.02';
+
+use Net::Trac::Connection;
+use Net::Trac::Ticket;
+use Net::Trac::TicketHistory;
+use Net::Trac::TicketAttachment;
+use Net::Trac::TicketSearch;
=head1 NAME
-Net::Trac
+Net::Trac - Interact with a remote Trac instance
=head1 SYNOPSIS
- my $trac = Net::Trac::Connection->new(
- url => 'http://trac.someproject.org',
- user => 'hiro',
- password => 'yatta'
- );
-
-
- my $ticket = Net::Trac::Ticket->new( connection => $trac);
- my $id = $ticket->create(summary => 'This product has only a moose, not a pony');
-
- my $other_ticket = Net::Trac::Ticket->new( connection => $trac);
- $other_ticket->load($id);
- print $other_ticket->summary;
-
- $ticket->update( summary => 'This project has no pony');
+ use Net::Trac;
+ my $trac = Net::Trac::Connection->new(
+ url => 'http://trac.someproject.org',
+ user => 'hiro',
+ password => 'yatta'
+ );
+
+ my $ticket = Net::Trac::Ticket->new( connection => $trac );
+ my $id = $ticket->create(summary => 'This product has only a moose, not a pony');
+
+ my $other_ticket = Net::Trac::Ticket->new( connection => $trac );
+ $other_ticket->load($id);
+ print $other_ticket->summary, "\n";
+ $ticket->update( summary => 'This project has no pony' );
=head1 DESCRIPTION
@@ -45,19 +53,23 @@
=head1 BUGS
This module currently only deals with Trac's bug tracking system.
+
This module is woefully incomplete.
-This module's error handling isn't what it should be
+
+This module's error handling isn't what it should be.
+
There are more.
Please send bug reports and patches to bug-net-trac at rt.cpan.org
=head1 AUTHOR
-Jesse Vincent <jesse at bestpractical.com>
+Jesse Vincent <jesse at bestpractical.com>, Thomas Sibley <trs at bestpractical.com>
=head1 LICENSE
-Copyright 2008 Best Practical Solutions.
+Copyright 2008-2009 Best Practical Solutions.
+
This package is licensed under the same terms as Perl 5.8.8.
=cut
Modified: Net-Trac/trunk/lib/Net/Trac/Connection.pm
==============================================================================
--- Net-Trac/trunk/lib/Net/Trac/Connection.pm (original)
+++ Net-Trac/trunk/lib/Net/Trac/Connection.pm Sat Jan 3 13:29:13 2009
@@ -1,4 +1,29 @@
+use strict;
+use warnings;
+
package Net::Trac::Connection;
+
+=head1 NAME
+
+Net::Trac::Connection - Connection to a remote Trac server
+
+=head1 DESCRIPTION
+
+This class represents a connection to a remote Trac instance. It is
+required by all other classes which need to talk to Trac.
+
+=head1 SYNOPSIS
+
+ use Net::Trac::Connection;
+
+ my $trac = Net::Trac::Connection->new(
+ url => 'http://trac.example.com',
+ user => 'snoopy',
+ password => 'doghouse'
+ );
+
+=cut
+
use Moose;
use XML::Feed;
@@ -8,10 +33,24 @@
use Params::Validate;
use Net::Trac::Mechanize;
+=head1 ACCESSORS
+
+=head2 url
+
+The url of the Trac instance used by this connection. Read-only after
+initialization.
+
+=head2 user
+
+=head2 password
+
+=cut
+
has url => (
isa => 'Str',
is => 'ro'
);
+
has user => (
isa => 'Str',
is => 'ro'
@@ -22,11 +61,27 @@
is => 'ro'
);
+=head1 ACCESSORS / MUTATORS
+
+=head2 logged_in [BOOLEAN]
+
+Gets/sets a boolean indicating whether or not the connection is logged in yet.
+
+=cut
+
has logged_in => (
isa => 'Bool',
is => 'rw'
);
+=head2 mech [MECH]
+
+Gets/sets the L<Net::Trac::Mechanize> (or subclassed) object for this
+connection to use. Unless you want to replace it with one of your own,
+the default will suffice.
+
+=cut
+
has mech => (
isa => 'Net::Trac::Mechanize',
is => 'ro',
@@ -38,10 +93,42 @@
$m->trac_user( $self->user );
$m->trac_password( $self->password );
return $m;
-
}
);
+=head1 METHODS
+
+=head2 new PARAMHASH
+
+Creates a new L<Net::Trac::Connection> given a paramhash with values for
+the keys C<url>, C<user>, and C<password>.
+
+=head2 ensure_logged_in
+
+Ensures this connection is logged in. Returns true on success, and undef
+on failure. Sets the C<logged_in> flag.
+
+=cut
+
+sub ensure_logged_in {
+ my $self = shift;
+ if ( !defined $self->logged_in ) {
+ $self->_fetch("/login") or return;
+ $self->logged_in(1);
+ }
+ return $self->logged_in;
+}
+
+=head1 PRIVATE METHODS
+
+=head2 _fetch URL
+
+Fetches the provided B<relative> URL from the Trac server. Returns undef
+on an error (after C<warn>ing) and the content (C<$self->mech->content>)
+on success.
+
+=cut
+
sub _fetch {
my $self = shift;
my $query = shift;
@@ -52,6 +139,14 @@
else { return $self->mech->content }
}
+=head2 _warn_on_error URL
+
+Checks the last request for an error condition and warns about them if found.
+Returns with a B<TRUE> value if errors occurred and a B<FALSE> value otherwise
+for nicer conditionals.
+
+=cut
+
sub _warn_on_error {
my $self = shift;
my $url = shift;
@@ -80,15 +175,12 @@
else { return }
}
-sub ensure_logged_in {
- my $self = shift;
- if ( !defined $self->logged_in ) {
- $self->_fetch("/login") or return;
- $self->logged_in(1);
- }
- return $self->logged_in;
+=head2 _fetch_feed URL
-}
+Fetches and parses a relative feed URL from the Trac server. Warns if an error
+occurs and returns undef. Otherwise returns an L<XML::Feed> object.
+
+=cut
sub _fetch_feed {
my $self = shift;
@@ -103,6 +195,15 @@
return $feed;
}
+=head2 _csv_to_struct PARAMHASH
+
+Takes a paramhash of the keys C<data> and C<key> and optionally C<type>.
+Given CSV data this method will return a reference to a hash (by default)
+or array (depending on the value of the C<type> key). C<key> specifies
+what field should be used as the key field when creating a hashref.
+
+=cut
+
sub _csv_to_struct {
my $self = shift;
my %args = validate( @_, { data => 1, key => 1, type => { default => 'hash' } } );
@@ -127,6 +228,14 @@
return $data;
}
+=head1 LICENSE
+
+Copyright 2008-2009 Best Practical Solutions.
+
+This package is licensed under the same terms as Perl 5.8.8.
+
+=cut
+
__PACKAGE__->meta->make_immutable;
no Moose;
Modified: Net-Trac/trunk/lib/Net/Trac/Mechanize.pm
==============================================================================
--- Net-Trac/trunk/lib/Net/Trac/Mechanize.pm (original)
+++ Net-Trac/trunk/lib/Net/Trac/Mechanize.pm Sat Jan 3 13:29:13 2009
@@ -1,15 +1,54 @@
+use strict;
+use warnings;
+
package Net::Trac::Mechanize;
+
+=head1 NAME
+
+Net::Trac::Mechanize - Provides persistent credentials for the Trac instance
+
+=head1 DESCRIPTION
+
+This class subclasses L<WWW::Mechanize> to provide persistent HTTP credentials
+when accessing a Trac instance.
+
+=cut
+
use Moose;
extends 'WWW::Mechanize';
+=head1 ACCESSORS / MUTATORS
+
+=head2 trac_user
+
+=head2 trac_password
+
+=cut
+
has trac_user => ( isa => 'Str', is => 'rw' );
has trac_password => ( isa => 'Str', is => 'rw' );
+=head1 METHODS
+
+=head2 get_basic_credentials
+
+Returns the credentials that L<WWW::Mechanize> expects.
+
+=cut
+
sub get_basic_credentials {
my $self = shift;
return ( $self->trac_user => $self->trac_password );
}
+=head1 LICENSE
+
+Copyright 2008-2009 Best Practical Solutions.
+
+This package is licensed under the same terms as Perl 5.8.8.
+
+=cut
+
# This is commented because it breaks the class, causing it to
# seemingly not follow HTTP redirects.
#__PACKAGE__->meta->make_immutable;
Modified: Net-Trac/trunk/lib/Net/Trac/Ticket.pm
==============================================================================
--- Net-Trac/trunk/lib/Net/Trac/Ticket.pm (original)
+++ Net-Trac/trunk/lib/Net/Trac/Ticket.pm Sat Jan 3 13:29:13 2009
@@ -1,4 +1,27 @@
+use strict;
+use warnings;
+
package Net::Trac::Ticket;
+
+=head1 NAME
+
+Net::Trac::Ticket - Create, read, and update tickets on a remote Trac instance
+
+=head1 SYNOPSIS
+
+ my $ticket = Net::Trac::Ticket->new( connection => $trac );
+ $ticket->load( 1 );
+
+ print $ticket->summary, "\n";
+
+=head1 DESCRIPTION
+
+This class represents a ticket on a remote Trac instance. It provides methods
+for creating, reading, and updating tickets and their history as well as adding
+comments and getting attachments.
+
+=cut
+
use Moose;
use Params::Validate qw(:all);
use Lingua::EN::Inflect qw();
@@ -61,6 +84,20 @@
$self->_fetch_new_ticket_metadata;
}
+=head1 METHODS
+
+=head2 new HASH
+
+Takes a key C<connection> with a value of a L<Net::Trac::Connection>. Returns
+an empty ticket object.
+
+=head2 load ID
+
+Loads up the ticket with the specified ID. Returns the ticket ID loaded on success
+and undef on failure.
+
+=cut
+
sub load {
my $self = shift;
my ($id) = validate_pos( @_, { type => SCALAR } );
@@ -75,6 +112,13 @@
return $tid;
}
+=head2 load_from_hashref HASHREF [SKIP]
+
+You should never need to use this method yourself. Loads a ticket from a hashref
+of data, optionally skipping metadata loading (values of C<valid_*> accessors).
+
+=cut
+
sub load_from_hashref {
my $self = shift;
my ($hash, $skip_metadata) = validate_pos(
@@ -183,6 +227,13 @@
return \%rules;
}
+=head2 create HASH
+
+Creates and loads a new ticket with the values specified.
+Returns undef on failure and the new ticket ID on success.
+
+=cut
+
sub create {
my $self = shift;
my %args = validate(
@@ -211,6 +262,17 @@
}
}
+=head2 update HASH
+
+Updates the current ticket with the specified values. This method will
+attempt to emulate Trac's default workflow by auto-updating the status
+based on changes to other fields. To avoid this auto-updating, specify
+a true value as the value for the key C<no_auto_status>.
+
+Returns undef on failure, and the ID of the current ticket on success.
+
+=cut
+
sub update {
my $self = shift;
my %args = validate(
@@ -259,12 +321,24 @@
}
}
+=head2 comment TEXT
+
+Adds a comment to the current ticket. Returns undef on failure, true on success.
+
+=cut
+
sub comment {
my $self = shift;
my ($comment) = validate_pos( @_, { type => SCALAR });
$self->update( comment => $comment );
}
+=head2 history
+
+Returns a L<Net::Trac::TicketHistory> object for this ticket.
+
+=cut
+
sub history {
my $self = shift;
my $hist = Net::Trac::TicketHistory->new({ connection => $self->connection });
@@ -272,6 +346,14 @@
return $hist;
}
+=head2 comments
+
+Returns an array or arrayref (depending on context) of history entries which
+have comments included. This will include history entries representing
+attachments if they have descriptions.
+
+=cut
+
sub comments {
my $self = shift;
my $hist = $self->history;
@@ -295,6 +377,14 @@
return undef;
}
+=head2 attach PARAMHASH
+
+Attaches the specified C<file> with an optional C<description>.
+Returns undef on failure and the new L<Net::Trac::TicketAttachment> object
+on success.
+
+=cut
+
sub attach {
my $self = shift;
my %args = validate( @_, { file => 1, description => 0 } );
@@ -340,12 +430,108 @@
}
}
+=head2 attachments
+
+Returns an array or arrayref (depending on context) of all the
+L<Net::Trac::TicketAttachment> objects for this ticket.
+
+=cut
+
sub attachments {
my $self = shift;
$self->_update_attachments;
return wantarray ? @{$self->_attachments} : $self->_attachments;
}
+=head1 ACCESSORS
+
+=head2 connection
+
+=head2 id
+
+=head2 summary
+
+=head2 type
+
+=head2 status
+
+=head2 priority
+
+=head2 severity
+
+=head2 resolution
+
+=head2 owner
+
+=head2 reporter
+
+=head2 cc
+
+=head2 description
+
+=head2 keywords
+
+=head2 component
+
+=head2 milestone
+
+=head2 version
+
+=head2 created
+
+Returns a L<DateTime> object
+
+=head2 last_modified
+
+Returns a L<DateTime> object
+
+=head2 basic_statuses
+
+Returns a list of the basic statuses available for a ticket. Others
+may be defined by the remote Trac instance, but we have no way of easily
+getting them.
+
+=head2 valid_props
+
+Returns a list of the valid properties of a ticket.
+
+=head2 valid_create_props
+
+Returns a list of the valid properties specifiable when creating a ticket.
+
+=head2 valid_update_props
+
+Returns a list of the valid updatable properties.
+
+=head2 Valid property values
+
+These accessors are loaded from the remote Trac instance with the valid
+values for the properties upon instantiation of a ticket object.
+
+=over
+
+=item valid_milestones
+
+=item valid_types
+
+=item valid_components
+
+=item valid_priorities
+
+=item valid_resolutions - Only loaded when a ticket is loaded.
+
+=item valid_severities - May not be provided by the Trac instance.
+
+=back
+
+=head1 LICENSE
+
+Copyright 2008-2009 Best Practical Solutions.
+
+This package is licensed under the same terms as Perl 5.8.8.
+
+=cut
+
__PACKAGE__->meta->make_immutable;
no Moose;
Modified: Net-Trac/trunk/lib/Net/Trac/TicketAttachment.pm
==============================================================================
--- Net-Trac/trunk/lib/Net/Trac/TicketAttachment.pm (original)
+++ Net-Trac/trunk/lib/Net/Trac/TicketAttachment.pm Sat Jan 3 13:29:13 2009
@@ -1,8 +1,56 @@
+use strict;
+use warnings;
+
package Net::Trac::TicketAttachment;
+
use Moose;
use Moose::Util::TypeConstraints;
use DateTime::Format::ISO8601;
+=head1 NAME
+
+Net::Trac::TicketAttachment - Represents a single attachment for a Trac ticket
+
+=head1 DESCRIPTION
+
+This class represents a single attachment for a Trac ticket. You do not want
+to deal with instantiating this class yourself. Instead let L<Net::Trac::Ticket>
+do the work.
+
+=head1 ACCESSORS
+
+=head2 connection
+
+Returns the L<Net::Trac::Connection> used by this class.
+
+=head2 ticket
+
+Returns the ID of the ticket to which this attachment belongs.
+
+=head2 filename
+
+=head2 description
+
+=head2 url
+
+Relative to the remote Trac instance URL as set in the L<Net::Trac::Connection>.
+
+=head2 content
+
+Fetches and returns the content from the URL.
+
+=head2 size
+
+In bytes.
+
+=head2 author
+
+=head2 date
+
+Returns a L<DateTime> object.
+
+=cut
+
has connection => (
isa => 'Net::Trac::Connection',
is => 'ro'
@@ -24,6 +72,15 @@
has author => ( isa => 'Str', is => 'rw' );
has size => ( isa => 'Int', is => 'rw' );
+=head1 PRIVATE METHODS
+
+=head2 _parse_html_chunk STRING
+
+Parses a specific chunk of HTML (as extracted by L<Net::Trac::Ticket>) into
+the various fields.
+
+=cut
+
sub _parse_html_chunk {
my $self = shift;
my $html = shift;
@@ -53,29 +110,11 @@
return $self->connection->_fetch( $self->url );
}
-=head1 NAME
-
-Net::Trac::TicketAttachment
-
-=head1 DESCRIPTION
-
-This class represents a single attachment for a trac ticket.
-
-=head1 METHODS
-
-=head2 filename
-
-=head2 description
-
-=head2 content
-
-=head2 size
+=head1 LICENSE
-=head2 url
+Copyright 2008-2009 Best Practical Solutions.
-=head2 author
-
-=head2 date
+This package is licensed under the same terms as Perl 5.8.8.
=cut
Modified: Net-Trac/trunk/lib/Net/Trac/TicketHistory.pm
==============================================================================
--- Net-Trac/trunk/lib/Net/Trac/TicketHistory.pm (original)
+++ Net-Trac/trunk/lib/Net/Trac/TicketHistory.pm Sat Jan 3 13:29:13 2009
@@ -1,17 +1,61 @@
+use strict;
+use warnings;
+
package Net::Trac::TicketHistory;
use Moose;
use Params::Validate qw(:all);
use Net::Trac::TicketHistoryEntry;
+=head1 NAME
+
+Net::Trac::TicketHistory - A Trac ticket's history
+
+=head1 SYNOPSIS
+
+ my $history = Net::Trac::TicketHistory->new( connection => $trac );
+ $history->load( 13 );
+
+ # Print the authors of all the changes to ticket #13
+ for ( @{ $history->entries } ) {
+ print $_->author, "\n";
+ }
+
+=head1 DESCRIPTION
+
+This class represents a Trac ticket's history and is really just a collection
+of L<Net::Trac::TicketHistoryEntries>.
+
+=head1 ACCESSORS
+
+=head2 connection
+
+=head2 ticket
+
+Returns the ID of the ticket whose history this object represents.
+
+=head2 entries
+
+Returns an arrayref of L<Net::Trac::TicketHistoryEntry>s.
+
+=cut
+
has connection => (
isa => 'Net::Trac::Connection',
is => 'ro'
);
-has ticket => ( isa => 'Str', is => 'rw' );
+has ticket => ( isa => 'Int', is => 'rw' );
has entries => ( isa => 'ArrayRef', is => 'rw' );
+=head1 METHODS
+
+=head2 load ID
+
+Loads the history of the specified ticket.
+
+=cut
+
sub load {
my $self = shift;
my ($id) = validate_pos( @_, { type => SCALAR } );
@@ -33,23 +77,11 @@
return 1;
}
-=head1 NAME
-
-Net::Trac::TicketHistory
+=head1 LICENSE
-=head1 DESCRIPTION
-
-This class represents a trac ticket's history
-
-=head1 METHODS
-
-=head2 load ID
-
-=head2 entries
-
-=head2 ticket
+Copyright 2008-2009 Best Practical Solutions.
-Returns the ticket's id
+This package is licensed under the same terms as Perl 5.8.8.
=cut
Modified: Net-Trac/trunk/lib/Net/Trac/TicketHistoryEntry.pm
==============================================================================
--- Net-Trac/trunk/lib/Net/Trac/TicketHistoryEntry.pm (original)
+++ Net-Trac/trunk/lib/Net/Trac/TicketHistoryEntry.pm Sat Jan 3 13:29:13 2009
@@ -1,7 +1,42 @@
+use strict;
+use warnings;
+
package Net::Trac::TicketHistoryEntry;
+
use Moose;
use Net::Trac::TicketPropChange;
+=head1 NAME
+
+Net::Trac::TicketHistoryEntry - A single history entry for a Trac ticket
+
+=head1 DESCRIPTION
+
+This class represents a single item in a Trac ticket history.
+
+=head1 ACCESSORS
+
+=head2 connection
+
+Returns a L<Net::Trac::Connection>.
+
+=head2 author
+
+=head2 date
+
+Returns a L<DateTime> object.
+
+=head2 category
+
+=head2 content
+
+=head2 prop_changes
+
+Returns a hashref (property names as the keys) of
+L<Net::Trac::TicketPropChange>s associated with this history entry.
+
+=cut
+
has connection => (
isa => 'Net::Trac::Connection',
is => 'ro'
@@ -14,6 +49,15 @@
has category => ( isa => 'Str', is => 'rw' );
has content => ( isa => 'Str', is => 'rw' );
+=head1 METHODS
+
+=head2 parse_feed_entry
+
+Takes an L<XML::Feed::Entry> from a ticket history feed and parses it to fill
+out the fields of this class.
+
+=cut
+
sub parse_feed_entry {
my $self = shift;
my $e = shift; # XML::Feed::Entry
@@ -66,25 +110,11 @@
return $props;
}
-=head1 NAME
-
-Net::Trac::TicketHistoryEntry
-
-=head1 DESCRIPTION
+=head1 LICENSE
-This class represents a single item in a trac ticket history update
+Copyright 2008-2009 Best Practical Solutions.
-=head1 METHODS
-
-=head2 author
-
-=head2 date
-
-=head2 category
-
-=head2 content
-
-=head2 prop_changes
+This package is licensed under the same terms as Perl 5.8.8.
=cut
Modified: Net-Trac/trunk/lib/Net/Trac/TicketPropChange.pm
==============================================================================
--- Net-Trac/trunk/lib/Net/Trac/TicketPropChange.pm (original)
+++ Net-Trac/trunk/lib/Net/Trac/TicketPropChange.pm Sat Jan 3 13:29:13 2009
@@ -1,10 +1,39 @@
+use strict;
+use warnings;
+
package Net::Trac::TicketPropChange;
use Moose;
+=head1 NAME
+
+Net::Trac::TicketPropChange - A single property change in a Trac ticket history entry
+
+=head1 DESCRIPTION
+
+A very simple class to represent a single property change in a history entry.
+
+=head1 ACCESSORS
+
+=head2 property
+
+=head2 old_value
+
+=head2 new_value
+
+=cut
+
has property => ( isa => 'Str', is => 'rw' );
has old_value => ( isa => 'Str', is => 'rw' );
has new_value => ( isa => 'Str', is => 'rw' );
+=head1 LICENSE
+
+Copyright 2008-2009 Best Practical Solutions.
+
+This package is licensed under the same terms as Perl 5.8.8.
+
+=cut
+
__PACKAGE__->meta->make_immutable;
no Moose;
Modified: Net-Trac/trunk/lib/Net/Trac/TicketSearch.pm
==============================================================================
--- Net-Trac/trunk/lib/Net/Trac/TicketSearch.pm (original)
+++ Net-Trac/trunk/lib/Net/Trac/TicketSearch.pm Sat Jan 3 13:29:13 2009
@@ -1,9 +1,53 @@
+use strict;
+use warnings;
+
package Net::Trac::TicketSearch;
use Moose;
use Params::Validate qw(:all);
+use URI::Escape qw(uri_escape);
use Net::Trac::Ticket;
+=head1 NAME
+
+Net::Trac::TicketSearch - A ticket search (custom query) in Trac
+
+=head1 SYNOPSIS
+
+ my $search = Net::Trac::TicketSearch->new( connection => $trac );
+
+ $search->query(
+ owner => 'hiro',
+ status => { 'not' => [qw(new reopened)] },
+ summary => { 'contains' => 'yatta!' },
+ reporter => [qw( foo at example.com bar at example.com )]
+ );
+
+ print $_->id, "\n" for @{$search->results};
+
+=head1 DESCRIPTION
+
+This class allows you to run ticket searches on a remote Trac instance.
+
+=head1 ACCESSORS
+
+=head2 connection
+
+=head2 limit [NUMBER]
+
+Get/set the maximum number of results to fetch. Default is 500. This may
+also be limited by the Trac instance itself.
+
+=head2 results
+
+Returns an arrayref of L<Net::Trac::Ticket>s for the current query.
+
+=head2 url
+
+Returns the relative URL for the current query (note the format will be CSV).
+
+=cut
+
has connection => (
isa => 'Net::Trac::Connection',
is => 'ro'
@@ -11,6 +55,25 @@
has limit => ( isa => 'Int', is => 'rw', default => sub { 500 } );
has results => ( isa => 'ArrayRef', is => 'rw', default => sub { [] } );
+has url => ( isa => 'Str', is => 'rw' );
+
+=head1 METHODS
+
+=head2 query [PARAMHASH]
+
+Performs a ticket search with the given search conditions. Specify a hash of
+C<column => value> pairs for which to search. Values may be a simple scalar,
+a hashref, or an arrayref. Specifying a hashref allows you to select a different
+operator for comparison (see below for a list). An arrayref allows multiple values
+to be B<or>'d for the same column. Unfortunately Trac has no way of B<and>ing
+multiple values for the same column.
+
+Valid operators are C<is> (default), C<not>, C<contains>, C<lacks>, C<startswith>,
+and C<endswith>.
+
+Returns undef on error and the L<results> otherwise.
+
+=cut
sub query {
my $self = shift;
@@ -22,11 +85,12 @@
$self->results([]);
# Build a URL from the fields we want and the query
- my $url = '/query?format=csv&order=id&max=' . $self->limit;
- $url .= '&' . join '&', map { "col=$_" } Net::Trac::Ticket->valid_props;
- $url .= '&' . join '&', map { "$_=".$query{$_} } keys %query;
+ my $base = '/query?format=csv&order=id&max=' . $self->limit;
+ $base .= '&' . join '&', map { "col=$_" } Net::Trac::Ticket->valid_props;
- my $content = $self->connection->_fetch( $url )
+ $self->url( $self->_build_query( $base, \%query ) );
+
+ my $content = $self->connection->_fetch( $self->url )
or return;
my $data = $self->connection->_csv_to_struct( data => \$content, key => 'id', type => 'array' );
@@ -45,6 +109,52 @@
}
}
+our %OPERATORS = (
+ undef => '',
+ '' => '',
+ is => '',
+ not => '!',
+ contains => '~',
+ lacks => '!~',
+ startswith => '^',
+ endswith => '$',
+);
+
+sub _build_query {
+ my $self = shift;
+ my $base = shift;
+ my $query = shift || {};
+ my $defaultop = $OPERATORS{ shift || 'is' } || '';
+
+ for my $key ( keys %$query ) {
+ my $value = $query->{$key};
+
+ if ( ref $value eq 'ARRAY' ) {
+ $base .= "&$key=" . uri_escape( $defaultop . $_ ) for @$value;
+ }
+ elsif ( ref $value eq 'HASH' ) {
+ my ($op, $v) = %$value;
+ $base .= $self->_build_query( '', { $key => $v }, $op );
+ }
+ elsif ( not ref $value ) {
+ $base .= "&$key=" . uri_escape( $defaultop . $value );
+ }
+ else {
+ warn "Skipping '$key = $value' in ticket search: value not understood.";
+ }
+ }
+
+ return $base;
+}
+
+=head1 LICENSE
+
+Copyright 2008-2009 Best Practical Solutions.
+
+This package is licensed under the same terms as Perl 5.8.8.
+
+=cut
+
__PACKAGE__->meta->make_immutable;
no Moose;
Modified: Net-Trac/trunk/t/02-create.t
==============================================================================
--- Net-Trac/trunk/t/02-create.t (original)
+++ Net-Trac/trunk/t/02-create.t Sat Jan 3 13:29:13 2009
@@ -1,7 +1,7 @@
use warnings;
use strict;
-use Test::More qw/no_plan/;
+use Test::More tests => 16;
use_ok('Net::Trac::Connection');
use_ok('Net::Trac::Ticket');
require 't/setup_trac.pl';
Modified: Net-Trac/trunk/t/50-full-api.t
==============================================================================
--- Net-Trac/trunk/t/50-full-api.t (original)
+++ Net-Trac/trunk/t/50-full-api.t Sat Jan 3 13:29:13 2009
@@ -1,4 +1,4 @@
-use Test::More qw/no_plan/;
+use Test::More tests => 24;
use_ok('Net::Trac::Connection');
use_ok('Net::Trac::Ticket');
require 't/setup_trac.pl';
Modified: Net-Trac/trunk/t/99-pod-coverage.t
==============================================================================
--- Net-Trac/trunk/t/99-pod-coverage.t (original)
+++ Net-Trac/trunk/t/99-pod-coverage.t Sat Jan 3 13:29:13 2009
@@ -2,9 +2,12 @@
eval "use Test::Pod::Coverage 1.00";
plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@;
plan skip_all => "Coverage tests only run for authors" unless ( -d 'inc/.author' );
-plan skip_all => "We know our coverage is bad :(";
+#plan skip_all => "We know our coverage is bad :(";
-all_pod_coverage_ok();
+all_pod_coverage_ok({
+ also_private => [qr/^BUILD$/],
+ trustme => [qr/^(?:time|changetime)$/],
+});
# Workaround for dumb bug (fixed in 5.8.7) where Test::Builder thinks that
# certain "die"s that happen inside evals are not actually inside evals,
Modified: Net-Trac/trunk/t/attachments.t
==============================================================================
--- Net-Trac/trunk/t/attachments.t (original)
+++ Net-Trac/trunk/t/attachments.t Sat Jan 3 13:29:13 2009
@@ -1,7 +1,7 @@
use warnings;
use strict;
-use Test::More qw/no_plan/;
+use Test::More tests => 29;
use_ok('Net::Trac::Connection');
use_ok('Net::Trac::Ticket');
require 't/setup_trac.pl';
Modified: Net-Trac/trunk/t/comments.t
==============================================================================
--- Net-Trac/trunk/t/comments.t (original)
+++ Net-Trac/trunk/t/comments.t Sat Jan 3 13:29:13 2009
@@ -1,7 +1,7 @@
use warnings;
use strict;
-use Test::More qw/no_plan/;
+use Test::More tests => 28;
use_ok('Net::Trac::Connection');
use_ok('Net::Trac::Ticket');
require 't/setup_trac.pl';
Modified: Net-Trac/trunk/t/parse_props.t
==============================================================================
--- Net-Trac/trunk/t/parse_props.t (original)
+++ Net-Trac/trunk/t/parse_props.t Sat Jan 3 13:29:13 2009
@@ -1,4 +1,4 @@
-use Test::More qw/no_plan/;
+use Test::More tests => 3;
my $props = <<'EOF';
Modified: Net-Trac/trunk/t/search.t
==============================================================================
--- Net-Trac/trunk/t/search.t (original)
+++ Net-Trac/trunk/t/search.t Sat Jan 3 13:29:13 2009
@@ -1,7 +1,7 @@
use warnings;
use strict;
-use Test::More qw/no_plan/;
+use Test::More tests => 60;
use_ok('Net::Trac::Connection');
use_ok('Net::Trac::TicketSearch');
require 't/setup_trac.pl';
@@ -20,34 +20,68 @@
my $ticket = Net::Trac::Ticket->new( connection => $trac );
isa_ok($ticket, 'Net::Trac::Ticket');
+# Ticket 1
can_ok($ticket => 'create');
ok($ticket->create(summary => 'Summary #1'));
-
can_ok($ticket, 'load');
ok($ticket->load(1));
like($ticket->state->{'summary'}, qr/Summary #1/);
like($ticket->summary, qr/Summary #1/, "The summary looks correct");
+ok($ticket->update( status => 'closed' ), "Status = closed");
+is($ticket->status, 'closed', "Set status");
+# Ticket 2
can_ok($ticket => 'create');
-ok($ticket->create(summary => 'Summary #2'));
-
+ok($ticket->create(summary => 'Summary #2', description => 'Moose?'));
can_ok($ticket, 'load');
ok($ticket->load(2));
like($ticket->state->{'summary'}, qr/Summary #2/);
like($ticket->summary, qr/Summary #2/, "The summary looks correct");
+like($ticket->description, qr/Moose/, "The description looks correct");
+
+# Ticket 3
+can_ok($ticket => 'create');
+ok($ticket->create(summary => 'Summary moose #3', description => 'Moose!'));
+can_ok($ticket, 'load');
+ok($ticket->load(3));
+like($ticket->state->{'summary'}, qr/Summary moose #3/);
+like($ticket->summary, qr/Summary moose #3/, "The summary looks correct");
+like($ticket->description, qr/Moose/, "The description looks correct");
+ok($ticket->update( status => 'reopened' ), "Status = reopened");
+is($ticket->status, 'reopened', "Set status");
my $search = Net::Trac::TicketSearch->new( connection => $trac );
isa_ok( $search, 'Net::Trac::TicketSearch' );
can_ok( $search => 'query' );
ok($search->query);
-is(@{$search->results}, 2, "Got two results");
+is(@{$search->results}, 3, "Got two results");
isa_ok($search->results->[0], 'Net::Trac::Ticket');
isa_ok($search->results->[1], 'Net::Trac::Ticket');
+isa_ok($search->results->[2], 'Net::Trac::Ticket');
is($search->results->[0]->summary, "Summary #1", "Got summary");
is($search->results->[1]->summary, "Summary #2", "Got summary");
+is($search->results->[2]->summary, "Summary moose #3", "Got summary");
ok($search->query( id => 2 ));
is(@{$search->results}, 1, "Got one result");
isa_ok($search->results->[0], 'Net::Trac::Ticket');
is($search->results->[0]->summary, "Summary #2", "Got summary");
+ok($search->query( summary => { contains => '#1' } ));
+is(@{$search->results}, 1, "Got one result");
+isa_ok($search->results->[0], 'Net::Trac::Ticket');
+is($search->results->[0]->summary, "Summary #1", "Got summary");
+
+ok($search->query( summary => { contains => ['moose', '#2'] } ));
+is(@{$search->results}, 2, "Got two tickets");
+isa_ok($search->results->[0], 'Net::Trac::Ticket');
+isa_ok($search->results->[1], 'Net::Trac::Ticket');
+is($search->results->[0]->summary, "Summary #2", "Got ticket #2");
+is($search->results->[1]->summary, "Summary moose #3", "Got ticket #3");
+
+ok($search->query( status => ['new','reopened'] ));
+is(@{$search->results}, 2, "Got two results");
+isa_ok($search->results->[0], 'Net::Trac::Ticket');
+isa_ok($search->results->[1], 'Net::Trac::Ticket');
+is($search->results->[0]->summary, "Summary #2", "Got ticket #2");
+is($search->results->[1]->summary, "Summary moose #3", "Got ticket #3");
Modified: Net-Trac/trunk/t/update.t
==============================================================================
--- Net-Trac/trunk/t/update.t (original)
+++ Net-Trac/trunk/t/update.t Sat Jan 3 13:29:13 2009
@@ -1,7 +1,7 @@
use warnings;
use strict;
-use Test::More qw/no_plan/;
+use Test::More tests => 29;
use_ok('Net::Trac::Connection');
use_ok('Net::Trac::Ticket');
use_ok('Net::Trac::TicketSearch');
More information about the Bps-public-commit
mailing list