[Bps-public-commit] r14969 - in Net-Trac/trunk: . lib/Net/Trac t
jesse at bestpractical.com
jesse at bestpractical.com
Sat Aug 9 22:11:26 EDT 2008
Author: jesse
Date: Sat Aug 9 22:11:25 2008
New Revision: 14969
Added:
Net-Trac/trunk/Makefile.PL
Net-Trac/trunk/lib/Net/Trac.pm
Net-Trac/trunk/lib/Net/Trac/Mechanize.pm
Net-Trac/trunk/t/02-create.t
Net-Trac/trunk/t/99-pod-coverage.t
Net-Trac/trunk/t/99-pod.t
Net-Trac/trunk/t/setup_trac.pl
Removed:
Net-Trac/trunk/t/basic.t
Modified:
Net-Trac/trunk/lib/Net/Trac/.Connection.pm.swp
Net-Trac/trunk/lib/Net/Trac/.Ticket.pm.swp
Net-Trac/trunk/lib/Net/Trac/Connection.pm
Net-Trac/trunk/lib/Net/Trac/Ticket.pm
Net-Trac/trunk/t/parse_props.t
Log:
* Basic creates now work
Added: Net-Trac/trunk/Makefile.PL
==============================================================================
--- (empty file)
+++ Net-Trac/trunk/Makefile.PL Sat Aug 9 22:11:25 2008
@@ -0,0 +1,18 @@
+use warnings;
+use strict;
+use inc::Module::Install;
+
+name 'Net-Trac';
+all_from 'lib/Net/Trac.pm';
+requires 'Moose';
+requires 'URI';
+requires 'IO::Scalar';
+requires 'XML::Feed';
+requires 'Text::CSV_XS';
+requires 'LWP::Simple';
+
+requires 'Params::Validate';
+
+auto_install;
+sign;
+WriteAll;
Added: Net-Trac/trunk/lib/Net/Trac.pm
==============================================================================
--- (empty file)
+++ Net-Trac/trunk/lib/Net/Trac.pm Sat Aug 9 22:11:25 2008
@@ -0,0 +1,10 @@
+package Net::Trac;
+use Moose;
+
+
+our $VERSION = '0.01_01';
+
+
+
+
+'This is the end of the file';
Modified: Net-Trac/trunk/lib/Net/Trac/.Connection.pm.swp
==============================================================================
Binary files. No diff available.
Modified: Net-Trac/trunk/lib/Net/Trac/.Ticket.pm.swp
==============================================================================
Binary files. No diff available.
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 Aug 9 22:11:25 2008
@@ -1,11 +1,13 @@
package Net::Trac::Connection;
use Moose;
-use LWP::Simple;
- use XML::Feed;
+
+use XML::Feed;
use URI;
use Text::CSV_XS;
use IO::Scalar;
use Params::Validate;
+use Net::Trac::Mechanize;
+
has url => (
isa => 'Str',
@@ -22,17 +24,67 @@
);
+has logged_in => (
+ isa => 'Bool',
+ is => 'rw');
+
+has mech => (
+ isa => 'Net::Trac::Mechanize',
+ is => 'ro',
+ lazy => 1,
+ default => sub {my $self = shift; my $m = Net::Trac::Mechanize->new();
+ $m->cookie_jar({});
+ $m->trac_user($self->user);
+ $m->trac_password( $self->password);
+ return $m;
+
+ }
+);
+
sub _fetch {
my $self = shift;
my $query = shift;
- return LWP::Simple::get($self->url.$query);
+ my $abs_url = $self->url.$query;
+ $self->mech->get($abs_url);
+ $self->_die_on_error($abs_url);
+ return $self->mech->content;
+}
+
+
+sub _die_on_error {
+ my $self = shift;
+ my $url = shift;
+ if (!$self->mech->response->is_success) {
+ die "Server threw an error ". $self->mech->response->status_line . " for " .$url;
+ }
+ elsif ($self->mech->content =~ qr{
+ <div id="content" class="error">
+ <h1>(.*?)</h1>
+ <p class="message">(.*?)</p>}ismx ) {
+ die "$1 $2";
+ }
+ else { return undef}
}
+
+sub ensure_logged_in {
+ my $self = shift;
+ if (!defined $self->logged_in) {
+ $self->_fetch( "/login");
+ warn $self->mech->response;
+ $self->logged_in(1);
+ }
+ return $self->logged_in;
+
+}
+
+
+
sub _fetch_feed {
- my $self = shift;
- my $query = shift;
- my $feed = XML::Feed->parse(URI->new($self->url .$query))
+ my $self = shift;
+ my $query = shift;
+ my $feed = XML::Feed->parse( URI->new( $self->url . $query ) )
or die XML::Feed->errstr;
return $feed;
@@ -41,8 +93,11 @@
my $self = shift;
my %args = validate( @_, { data => 1, key => 1 } );
my $csv = Text::CSV_XS->new( { binary => 1 } );
- my $io = IO::Scalar->new( $args{'data'} );
- $csv->column_names( $csv->getline($io) );
+ my $x = $args{'data'};
+ my $io = IO::Scalar->new( $x);
+ my @cols = @{$csv->getline($io)||[]};
+ return unless defined $cols[0];
+ $csv->column_names( @cols);
my $hashref;
while ( my $row = $csv->getline_hr($io) ) {
$hashref->{ $row->{ $args{'key'} } } = $row;
Added: Net-Trac/trunk/lib/Net/Trac/Mechanize.pm
==============================================================================
--- (empty file)
+++ Net-Trac/trunk/lib/Net/Trac/Mechanize.pm Sat Aug 9 22:11:25 2008
@@ -0,0 +1,13 @@
+
+package Net::Trac::Mechanize;
+use Moose;
+extends 'WWW::Mechanize';
+
+has trac_user => ( isa => 'Str', is => 'rw');
+has trac_password => ( isa => 'Str', is => 'rw');
+
+sub get_basic_credentials {
+ my $self = shift;
+ return ($self->trac_user => $self->trac_password);
+}
+1;
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 Aug 9 22:11:25 2008
@@ -5,41 +5,120 @@
has connection => (
isa => 'Net::Trac::Connection',
- is => 'ro'
- );
+ is => 'ro'
+);
has state => (
isa => 'HashRef',
- is => 'rw'
+ is => 'rw'
);
-our @PROPS = qw(cc component description id keywords milestone
- owner priority reporter resolution status summary type);
+has valid_milestones => ( isa => 'ArrayRef', is => 'rw' );
+has valid_types => ( isa => 'ArrayRef', is => 'rw' );
+has valid_components => ( isa => 'ArrayRef', is => 'rw' );
+has valid_priorities => ( isa => 'ArrayRef', is => 'rw' );
+our @PROPS = qw(cc component description id keywords milestone
+ owner priority reporter resolution status summary type);
for my $prop (@PROPS) {
no strict 'refs';
- *{"Net::Trac::Ticket::".$prop} = sub { shift->state->{$prop}};
+ *{ "Net::Trac::Ticket::" . $prop } = sub { shift->state->{$prop} };
}
-
sub load {
my $self = shift;
my ($id) = validate_pos( @_, { type => SCALAR } );
- my $state = $self->connection->_fetch( "/ticket/" . $id . "?format=csv" );
- my $stateref = $self->connection->_csv_to_struct(data => \$state, key => 'id');
- $self->state($stateref->{$id});
+ $self->connection->_fetch( "/ticket/" . $id . "?format=csv" );
+
+
+ my $content = $self->connection->mech->content;
+
+ my $stateref
+ = $self->connection->_csv_to_struct( data => \$content , key => 'id' );
+ return undef unless $stateref;
+ $self->state( $stateref->{$id} );
+ return $id;
+
}
-sub history {
+sub _get_new_ticket_form {
my $self = shift;
- my $hist = Net::Trac::TicketHistory->new( {connection => $self->connection, ticket => $self->id });
- $hist->load;
+ $self->connection->ensure_logged_in;
+ $self->connection->_fetch("/newticket");
+ for my $form ( $self->connection->mech->forms() ) {
+ return $form if $form->find_input('field_reporter');
+
+ }
+
+ return undef;
+}
+
+sub _fetch_new_ticket_metadata {
+ my $self = shift;
+ my $form = $self->_get_new_ticket_form;
+
+ return undef unless $form;
+ $self->valid_milestones(
+ [ $form->find_input("field_milestone")->possible_values ] );
+ $self->valid_types( [ $form->find_input("field_type")->possible_values ] );
+ $self->valid_components(
+ [ $form->find_input("field_component")->possible_values ] );
+ $self->valid_priorities(
+ [ $form->find_input("field_priority")->possible_values ] );
+
+ my @inputs = $form->inputs;
+
+ for my $in (@inputs) {
+ my @values = $in->possible_values;
+ }
+ return 1;
}
+sub create {
+ 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_new_ticket_form();
+
+
+ my %form = map {
+ 'field_'.$_ => $args{$_}
+ } keys %args;
+ $self->connection->mech->submit_form( form_number => 2, # BRITTLE
+ fields => {
+ %form,
+ submit => 1
+ });
+ my $reply = $self->connection->mech->response;
+}
+
+sub history {
+ my $self = shift;
+ my $hist = Net::Trac::TicketHistory->new(
+ { connection => $self->connection, ticket => $self->id } );
+ $hist->load;
+
+}
#http://barnowl.mit.edu/ticket/36?format=tab
1;
Added: Net-Trac/trunk/t/02-create.t
==============================================================================
--- (empty file)
+++ Net-Trac/trunk/t/02-create.t Sat Aug 9 22:11:25 2008
@@ -0,0 +1,35 @@
+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();
+$tr->port( int(60000 + rand(2000)));
+$tr->dir(tempdir( CLEANUP => 0));
+$tr->init;
+$tr->daemonize;
+diag($tr->url);
+
+sleep 3;
+
+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'));
+
+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");
+ok($ticket->history, "The ticket has some history");
+
+DESTROY {
+ $tr->kill_trac;
+}
Added: Net-Trac/trunk/t/99-pod-coverage.t
==============================================================================
--- (empty file)
+++ Net-Trac/trunk/t/99-pod-coverage.t Sat Aug 9 22:11:25 2008
@@ -0,0 +1,15 @@
+use Test::More;
+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 :(";
+
+all_pod_coverage_ok();
+
+# 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,
+# because caller() is broken if you turn on $^P like Module::Refresh does
+#
+# (I mean, if we've gotten to this line, then clearly the test didn't die, no?)
+Test::Builder->new->{Test_Died} = 0;
+
Added: Net-Trac/trunk/t/99-pod.t
==============================================================================
--- (empty file)
+++ Net-Trac/trunk/t/99-pod.t Sat Aug 9 22:11:25 2008
@@ -0,0 +1,5 @@
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
+
Modified: Net-Trac/trunk/t/parse_props.t
==============================================================================
--- Net-Trac/trunk/t/parse_props.t (original)
+++ Net-Trac/trunk/t/parse_props.t Sat Aug 9 22:11:25 2008
@@ -12,8 +12,8 @@
use_ok('Net::Trac::TicketHistoryEntry');
my $e = Net::Trac::TicketHistoryEntry->new();
-my $props = $e->_parse_props($props);
-is(scalar keys %$props, 4, "Four properties");
+my $prop_data = $e->_parse_props($props);
+is(scalar keys %$prop_data, 4, "Four properties");
my @keys = sort (qw(owner status type description));
-is_deeply([sort keys %$props], [sort @keys]);
+is_deeply([sort keys %$prop_data], [sort @keys]);
Added: Net-Trac/trunk/t/setup_trac.pl
==============================================================================
--- (empty file)
+++ Net-Trac/trunk/t/setup_trac.pl Sat Aug 9 22:11:25 2008
@@ -0,0 +1,112 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+
+use Test::More;
+use File::Temp qw/tempdir/;
+
+
+
+package Net::Trac::TestHarness;
+
+sub new {
+ my $class = shift;
+ my $self = {};
+ bless $self, $class;
+ return $self;
+}
+
+sub port {
+ my $self = shift;
+ if (@_) {
+ $self->{_port} = shift;
+ }
+ return $self->{_port};
+}
+
+sub dir {
+ my $self = shift;
+ if (@_) {
+ $self->{_dir} = shift;
+ }
+ return $self->{_dir};
+}
+
+
+sub pid {
+ my $self = shift;
+ if (@_) {
+ $self->{_pid} = shift;
+ }
+ return $self->{_pid};
+}
+
+
+
+sub url {
+ my $self = shift;
+ if (@_) {
+ $self->{_url} = shift;
+ }
+ 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|" );
+ my @content = <$sys>;
+ my ($url) = grep { defined $_ }
+ map { /Then point your browser to (.*)\./ ? $1 : undef } @content;
+ close($sys);
+ $url =~ s/8000/$port/;
+ $self->url($url);
+
+ $self->_grant_hiro();
+
+}
+
+sub _grant_hiro {
+ my $self = shift;
+ my $dir = $self->dir;
+open (my $sysadm, "trac-admin $dir/trac permission add hiro TRAC_ADMIN|");
+my @results = <$sysadm>;
+close ($sysadm);
+
+open(my $htpasswd, ">$dir/trac/conf/htpasswd") || die $!;
+# hiro / yatta
+print $htpasswd "hiro:trac:98aef54bbd280226ac74b6bc500ff70e\n";
+close $htpasswd;
+
+};
+
+
+sub kill_trac {
+ my $self = shift;
+ kill 1, $self->pid;
+
+}
+ sub daemonize {
+ my $self = shift;
+ my $dir = $self->dir;
+ my $port = $self->port;
+ chdir $dir."/trac";
+ open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
+ open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!";
+ defined(my $pid = fork) or die "Can't fork: $!";
+ if ( $pid ) {
+ $self->pid($pid);
+ return $pid;
+ } else {
+ open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
+ exec("tracd -p $port -a trac,$dir/trac/conf/htpasswd,trac $dir/trac") || die "Tracd";
+ }
+ }
+
+
+ 1;
More information about the Bps-public-commit
mailing list