[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