[Bps-public-commit] r17459 - in Net-Trac/trunk: . t

trs at bestpractical.com trs at bestpractical.com
Tue Dec 30 18:00:32 EST 2008


Author: trs
Date: Tue Dec 30 18:00:32 2008
New Revision: 17459

Added:
   Net-Trac/trunk/lib/Net/Trac/TicketAttachment.pm
   Net-Trac/trunk/t/attachments.t
Modified:
   Net-Trac/trunk/   (props changed)
   Net-Trac/trunk/Makefile.PL
   Net-Trac/trunk/lib/Net/Trac/Ticket.pm

Log:
 r43278 at zot:  tom | 2008-12-30 18:00:01 -0500
 first pass at attachments, both uploading and getting


Modified: Net-Trac/trunk/Makefile.PL
==============================================================================
--- Net-Trac/trunk/Makefile.PL	(original)
+++ Net-Trac/trunk/Makefile.PL	Tue Dec 30 18:00:32 2008
@@ -14,6 +14,7 @@
 requires 'LWP::Simple';
 requires 'Params::Validate';
 requires 'WWW::Mechanize' => '1.52';
+requires 'DateTime::Format::ISO8601';
 
 auto_install;
 sign; 

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	Tue Dec 30 18:00:32 2008
@@ -1,7 +1,9 @@
 package Net::Trac::Ticket;
 use Moose;
 use Params::Validate qw(:all);
+
 use Net::Trac::TicketHistory;
+use Net::Trac::TicketAttachment;
 
 has connection => (
     isa => 'Net::Trac::Connection',
@@ -13,6 +15,8 @@
     is  => 'rw'
 );
 
+has _attachments     => ( isa => 'ArrayRef', is => 'rw' );
+
 has valid_milestones => ( isa => 'ArrayRef', is => 'rw' );
 has valid_types      => ( isa => 'ArrayRef', is => 'rw' );
 has valid_components => ( isa => 'ArrayRef', is => 'rw' );
@@ -158,6 +162,8 @@
 
     my $reply = $self->connection->mech->response;
 
+    # XXX TODO: use _die_on_error here?
+
     if ( $reply->is_success ) {
         return $self->load($self->id);
     }
@@ -191,5 +197,67 @@
     return wantarray ? @comments : \@comments;
 }
 
+sub _get_add_attachment_form {
+    my $self = shift;
+    $self->connection->ensure_logged_in;
+    $self->connection->_fetch("/attachment/ticket/".$self->id."/?action=new");
+    my $i = 1; # form number;
+    for my $form ( $self->connection->mech->forms() ) {
+        return ($form,$i) if $form->find_input('attachment');
+        $i++;
+    }
+    return undef;
+}
+
+sub attach {
+    my $self = shift;
+    my %args = validate( @_, { file => 1, description => 0 } );
+
+    my ($form, $form_num)  = $self->_get_add_attachment_form();
+
+    $self->connection->mech->submit_form(
+        form_number => $form_num,
+        fields => {
+            attachment  => $args{'file'},
+            description => $args{'description'},
+            replace     => 0
+        }
+    );
+
+    my $reply = $self->connection->mech->response;
+    $self->connection->_die_on_error( $reply->base->as_string );
+
+    return $self->attachments->[-1];
+}
+
+sub _update_attachments {
+    my $self = shift;
+    $self->connection->ensure_logged_in;
+    my $content = $self->connection->_fetch("/attachment/ticket/".$self->id."/");
+    
+    if ( $content =~ m{<dl class="attachments">(.+?)</dl>}is ) {
+        my $html = $1;
+        my @attachments;
+
+        while ( $html =~ m{<dt>(.+?)</dd>}gis ) {
+            my $fragment = $1;
+            my $attachment = Net::Trac::TicketAttachment->new({
+                connection => $self->connection,
+                ticket     => $self->id
+            });
+            $attachment->_parse_html( $fragment );
+            push @attachments, $attachment;
+        }
+        $self->_attachments( \@attachments );
+    }
+}
+
+sub attachments {
+    my $self = shift;
+    $self->_update_attachments;
+    return wantarray ? @{$self->_attachments} : $self->_attachments;
+}
+
 #http://barnowl.mit.edu/ticket/36?format=tab
 1;
+

Added: Net-Trac/trunk/lib/Net/Trac/TicketAttachment.pm
==============================================================================
--- (empty file)
+++ Net-Trac/trunk/lib/Net/Trac/TicketAttachment.pm	Tue Dec 30 18:00:32 2008
@@ -0,0 +1,84 @@
+package Net::Trac::TicketAttachment;
+use Moose;
+use Moose::Util::TypeConstraints;
+use DateTime::Format::ISO8601;
+
+has connection => (
+    isa => 'Net::Trac::Connection',
+    is  => 'ro'
+);
+
+subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
+coerce  'DateTime' => from 'Str'  => via {
+    # Trac formats ISO8601 dates wrong
+    s/Z//;
+    s/([+-]\d\d)(\d\d)$/$1:$2/;
+    DateTime::Format::ISO8601->parse_datetime( $_ );
+};
+
+has ticket      => ( isa => 'Int',      is => 'ro' );
+has date        => ( isa => 'DateTime', is => 'rw', coerce => 1 );
+has filename    => ( isa => 'Str',      is => 'rw' );
+has description => ( isa => 'Str',      is => 'rw' );
+has url         => ( isa => 'Str',      is => 'rw' );
+has author      => ( isa => 'Str',      is => 'rw' );
+has size        => ( isa => 'Int',      is => 'rw' );
+
+sub _parse_html {
+    my $self = shift;
+    my $html = shift;
+
+#      <a href="/trac/attachment/ticket/1/xl0A1UDD4i" title="View attachment">xl0A1UDD4i</a>
+#      (<span title="27 bytes">27 bytes</span>) - added by <em>hiro</em>
+#      <a class="timeline" href="/trac/timeline?from=2008-12-30T15%3A45%3A24Z-0500&precision=second" title="2008-12-30T15:45:24Z-0500 in Timeline">0 seconds</a> ago.
+#    </dt>
+#                <dd>
+#                  Test description
+    
+    $self->_fill_property( $html, 'filename', qr{<a (?:.+?) title="View attachment">(.+?)</a>} );
+    $self->url( "/attachment/ticket/" . $self->ticket . "/" . $self->filename )
+        if defined $self->filename;
+
+    $self->_fill_property( $html, size          => qr{<span title="(\d+) bytes">} );
+    $self->_fill_property( $html, author        => qr{added by <em>(.+?)</em>} );
+    $self->_fill_property( $html, date          => qr{<a (?:.+?) title="(.+?) in Timeline">} );
+    $self->_fill_property( $html, description   => qr{<dd>\s*(\S.*?)\s*$} );
+
+    return 1;
+}
+
+sub _fill_property {
+    my ($self, $html, $prop, $regex) = @_;
+    if ( $html =~ $regex ) {
+        $self->$prop( $1 );
+    }
+    else { warn "Unable to find attachment $prop!" }
+}
+
+=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
+
+=head2 url
+
+=head2 author
+
+=head2 date
+
+=cut
+
+1;

Added: Net-Trac/trunk/t/attachments.t
==============================================================================
--- (empty file)
+++ Net-Trac/trunk/t/attachments.t	Tue Dec 30 18:00:32 2008
@@ -0,0 +1,55 @@
+use warnings; 
+use strict;
+
+use Test::More qw/no_plan/;
+use_ok('Net::Trac::Connection');
+use_ok('Net::Trac::Ticket');
+require 't/setup_trac.pl';
+
+use File::Temp qw(tempfile);
+
+
+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 => '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");
+
+can_ok($ticket => 'update');
+ok($ticket->update( comment => 'I like moose.' ), "Creating comment about moose.");
+is(@{$ticket->history->entries}, 1, "Got one history entry.");
+like($ticket->history->entries->[0]->content, qr/I like moose./, "The comment looks correct.");
+
+my ($fh, $filename) = tempfile();
+print $fh "A".."Z", "\n"; # 27 bytes
+close $fh;
+
+ok(-e $filename, "temp file exists: $filename");
+ok(-s $filename, "temp file has non-zero size");
+can_ok($ticket => 'attach');
+ok($ticket->attach( file => $filename, description => 'Test description' ), "Attaching file.");
+is(@{$ticket->history->entries}, 2, "Got two history entries.");
+is(@{$ticket->attachments}, 1, "Got one attachment");
+is($ticket->attachments->[-1]->size, 27, "Got right size!");
+is($ticket->attachments->[-1]->author, 'hiro', "Got right author!");
+like($filename, qr/\E@{[$ticket->attachments->[-1]->filename]}\E/, "Got right filename!");
+is($ticket->attachments->[-1]->description, 'Test description', "Got right description!");
+



More information about the Bps-public-commit mailing list