[Bps-public-commit] r15212 - in Net-Trac/trunk: . lib/Net/Trac t
jesse at bestpractical.com
jesse at bestpractical.com
Mon Aug 18 08:26:03 EDT 2008
Author: jesse
Date: Mon Aug 18 08:26:02 2008
New Revision: 15212
Added:
Net-Trac/trunk/t/50-full-api.t
Removed:
Net-Trac/trunk/lib/Net/Trac/.Connection.pm.swp
Net-Trac/trunk/lib/Net/Trac/.Ticket.pm.swp
Modified:
Net-Trac/trunk/ (props changed)
Net-Trac/trunk/lib/Net/Trac.pm
Net-Trac/trunk/lib/Net/Trac/Connection.pm
Net-Trac/trunk/lib/Net/Trac/Ticket.pm
Net-Trac/trunk/lib/Net/Trac/TicketHistory.pm
Net-Trac/trunk/lib/Net/Trac/TicketHistoryEntry.pm
Net-Trac/trunk/t/01-dependencies.t
Net-Trac/trunk/t/02-create.t
Net-Trac/trunk/t/setup_trac.pl
Log:
mergedown
Modified: Net-Trac/trunk/lib/Net/Trac.pm
==============================================================================
--- Net-Trac/trunk/lib/Net/Trac.pm (original)
+++ Net-Trac/trunk/lib/Net/Trac.pm Mon Aug 18 08:26:02 2008
@@ -3,4 +3,63 @@
our $VERSION = '0.01_01';
+=head1 NAME
+
+Net::Trac
+
+=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');
+
+
+
+=head1 DESCRIPTION
+
+Net::Trac is simple client library for a remote Trac instance.
+Because Trac doesn't provide a web services API, this module
+currently "fakes" an RPC interface around Trac's webforms and
+the feeds it exports. Because of this, it's somewhat more brittle
+than a true RPC client would be.
+
+As of now, this module has been tested against Trac 10.4 and Trac 11.0.
+
+The author's needs for this module are somewhat modest and its
+current featureset reflects this. Right now, only basic read/write
+functionality for Trac's tickets is provided. Patches would be gratefully
+appreciated.
+
+=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
+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>
+
+=head1 LICENSE
+
+Copyright 2008 Best Practical Solutions.
+This package is licensed under the same terms as Perl 5.8.8.
+
+=cut
+
'This is the end of the file';
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 Mon Aug 18 08:26:02 2008
@@ -75,7 +75,6 @@
my $self = shift;
if ( !defined $self->logged_in ) {
$self->_fetch("/login");
- warn $self->mech->response;
$self->logged_in(1);
}
return $self->logged_in;
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 Mon Aug 18 08:26:02 2008
@@ -47,9 +47,17 @@
$self->connection->_fetch("/newticket");
for my $form ( $self->connection->mech->forms() ) {
return $form if $form->find_input('field_reporter');
-
}
+ return undef;
+}
+sub _get_update_ticket_form {
+ my $self = shift;
+ $self->connection->ensure_logged_in;
+ $self->connection->_fetch("/ticket/".$self->id);
+ for my $form ( $self->connection->mech->forms() ) {
+ return $form if $form->find_input('field_reporter');
+ }
return undef;
}
@@ -105,14 +113,57 @@
);
my $reply = $self->connection->mech->response;
+ if ($reply->title =~ /^#(\d+)/) {
+ my $id = $1;
+ $self->load($id);
+ return $id;
+ } else {
+ return undef;
+ }
}
+
+sub update {
+ my $self = shift;
+ my %args = validate(
+ @_,
+ { summary => 0,
+ reporter => 0,
+ description => 0,
+ owner => 0,
+ type => 0,
+ priority => 0,
+ milestone => 0,
+ component => 0,
+ version => 0,
+ keywords => 0,
+ cc => 0,
+ status => 0
+
+ }
+ );
+
+ my $form = $self->_get_update_ticket_form();
+
+ my %form = map { 'field_' . $_ => $args{$_} } keys %args;
+
+ $self->connection->mech->submit_form(
+ form_name => 'propform',
+ fields => { %form, submit => 1 }
+ );
+
+ my $reply = $self->connection->mech->response;
+ $self->load($self->id);
+
+}
+
+
sub history {
my $self = shift;
my $hist = Net::Trac::TicketHistory->new(
{ connection => $self->connection, ticket => $self->id } );
$hist->load;
-
+ return $hist;
}
#http://barnowl.mit.edu/ticket/36?format=tab
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 Mon Aug 18 08:26:02 2008
@@ -36,4 +36,24 @@
return 1;
}
+=head1 NAME
+
+Net::Trac::TicketHistory
+
+=head1 DESCRIPTION
+
+This class represents a trac ticket's history
+
+=head1 METHODS
+
+=head2 load
+
+=head2 entries
+
+=head2 ticket
+
+Returns the ticket's id
+
+=cut
+
1;
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 Mon Aug 18 08:26:02 2008
@@ -70,4 +70,26 @@
return $props;
}
+=head1 NAME
+
+Net::Trac::TicketHistoryEntry
+
+=head1 DESCRIPTION
+
+This class represents a single item in a trac ticket history update
+
+=head1 METHODS
+
+=head2 author
+
+=head2 date
+
+=head2 category
+
+=head2 content
+
+=head2 prop_changes
+
+=cut
+
1;
Modified: Net-Trac/trunk/t/01-dependencies.t
==============================================================================
--- Net-Trac/trunk/t/01-dependencies.t (original)
+++ Net-Trac/trunk/t/01-dependencies.t Mon Aug 18 08:26:02 2008
@@ -18,7 +18,7 @@
plan 'no_plan';
my %used;
-find( \&wanted, qw/ lib bin t / );
+find( \&wanted, qw/ lib t / );
sub wanted {
return unless -f $_;
Modified: Net-Trac/trunk/t/02-create.t
==============================================================================
--- Net-Trac/trunk/t/02-create.t (original)
+++ Net-Trac/trunk/t/02-create.t Mon Aug 18 08:26:02 2008
@@ -1,3 +1,6 @@
+use warnings;
+use strict;
+
use Test::More qw/no_plan/;
use_ok('Net::Trac::Connection');
use_ok('Net::Trac::Ticket');
@@ -5,16 +8,15 @@
my $tr = Net::Trac::TestHarness->new();
-$tr->port( int(60000 + rand(2000)));
-$tr->dir(tempdir( CLEANUP => 0));
-$tr->init;
-$tr->daemonize;
-diag($tr->url);
+ok($tr->start_test_server(), "The server started!");
-sleep 3;
+my $trac = Net::Trac::Connection->new(
+ url => $tr->url,
+ user => 'hiro',
+ password => 'yatta'
+);
-my $trac = Net::Trac::Connection->new(url => $tr->url, user => 'hiro', password=> 'yatta');
-isa_ok($trac, "Net::Trac::Connection");
+isa_ok( $trac, "Net::Trac::Connection" );
is($trac->url, $tr->url);
my $ticket = Net::Trac::Ticket->new( connection => $trac);
isa_ok($ticket, 'Net::Trac::Ticket');
@@ -29,7 +31,3 @@
like($ticket->state->{'summary'}, qr/pony/);
like($ticket->summary, qr/pony/, "The summary looks like a pony");
ok($ticket->history, "The ticket has some history");
-
-DESTROY {
- $tr->kill_trac;
-}
Added: Net-Trac/trunk/t/50-full-api.t
==============================================================================
--- (empty file)
+++ Net-Trac/trunk/t/50-full-api.t Mon Aug 18 08:26:02 2008
@@ -0,0 +1,51 @@
+use Test::More qw/no_plan/;
+use_ok('Net::Trac::Connection');
+use_ok('Net::Trac::Ticket');
+require 't/setup_trac.pl';
+
+
+my $tr = Net::Trac::TestHarness->new();
+
+ok($tr->start_test_server(), "The server started!");
+
+
+my $trac = Net::Trac::Connection->new(
+ url => $tr->url,
+ user => 'hiro',
+ password => 'yatta'
+);
+
+isa_ok( $trac, "Net::Trac::Connection" );
+is($trac->url, $tr->url);
+my $ticket = Net::Trac::Ticket->new( connection => $trac);
+isa_ok($ticket, 'Net::Trac::Ticket');
+
+can_ok($ticket => '_fetch_new_ticket_metadata');
+ok($ticket->_fetch_new_ticket_metadata);
+can_ok($ticket => 'create');
+ok($ticket->create(summary => 'This product has only a moose, not a pony'));
+is($ticket->id, 1);
+
+can_ok($ticket, 'load');
+ok($ticket->load(1));
+like($ticket->state->{'summary'}, qr/pony/);
+like($ticket->summary, qr/pony/, "The summary looks like a pony");
+like($ticket->summary, qr/moose/, "The summary looks like a moose");
+
+ok( $ticket->update(
+ summary => 'The product does not contain a pony'
+
+
+ ), "updated!");
+
+like($ticket->summary, qr/pony/, "The summary looks like a pony");
+unlike($ticket->summary, qr/moose/, "The summary does not look like a moose");
+
+my $history = $ticket->history;
+ok($history, "The ticket has some history");
+isa_ok($history, 'Net::Trac::TicketHistory');
+can_ok($history, 'entries');
+my @entries = @{$history->entries};
+my $first = shift @entries;
+is($entries[0], undef);
+is ($first->category, 'Ticket');
Modified: Net-Trac/trunk/t/setup_trac.pl
==============================================================================
--- Net-Trac/trunk/t/setup_trac.pl (original)
+++ Net-Trac/trunk/t/setup_trac.pl Mon Aug 18 08:26:02 2008
@@ -1,15 +1,15 @@
#!/usr/bin/perl
+package Net::Trac::TestHarness;
use warnings;
use strict;
use Test::More;
use File::Temp qw/tempdir/;
+use LWP::Simple qw/get/;
+use Time::HiRes qw/usleep/;
-
-package Net::Trac::TestHarness;
-
sub new {
my $class = shift;
my $self = {};
@@ -17,6 +17,25 @@
return $self;
}
+sub start_test_server {
+my $self = shift;
+$self->port( int(60000 + rand(2000)));
+$self->dir(tempdir( CLEANUP => 0));
+$self->init;
+$self->daemonize;
+
+return $self->_did_server_start;
+}
+
+sub _did_server_start {
+ my $self = shift;
+ for ( 1 .. 200 ) {
+ return 1 if eval { get( $self->url ) };
+ usleep 5000;
+ }
+ die "Server didn't start";
+}
+
sub port {
my $self = shift;
if (@_) {
@@ -33,7 +52,6 @@
return $self->{_dir};
}
-
sub pid {
my $self = shift;
if (@_) {
@@ -42,8 +60,6 @@
return $self->{_pid};
}
-
-
sub url {
my $self = shift;
if (@_) {
@@ -52,14 +68,12 @@
return $self->{_url};
}
-
-
sub init {
my $self = shift;
my $dir = $self->dir;
my $port = $self->port;
open( my $sys,
- "trac-admin $dir/trac initenv proj sqlite:db/trac.db $dir/trac trac|" );
+ "trac-admin $dir/trac initenv proj sqlite:db/trac.db svn ''|" );
my @content = <$sys>;
my ($url) = grep { defined $_ }
map { /Then point your browser to (.*)\./ ? $1 : undef } @content;
@@ -109,4 +123,9 @@
}
+sub DESTROY {
+ my $self = shift;
+ $self->kill_trac;
+}
+
1;
More information about the Bps-public-commit
mailing list