[Bps-public-commit] r11555 - in SVN-PropDB: lib/Prophet t

[clkao at bestpractical.com]

Author: clkao
Date: Sat Apr  5 19:47:20 2008
New Revision: 11555

Added:
   SVN-PropDB/t/sd-hm.t
Modified:
   SVN-PropDB/lib/Prophet/Replica.pm
   SVN-PropDB/lib/Prophet/Replica/Hiveminder.pm
   SVN-PropDB/lib/Prophet/Test.pm

Log:
- make test find bin/ based on $0, so we can run tests from
  other directories like sd-hm requires.
- dispatch to replica::hiveminder based on url.


Modified: SVN-PropDB/lib/Prophet/Replica.pm
==============================================================================
--- SVN-PropDB/lib/Prophet/Replica.pm	(original)
+++ SVN-PropDB/lib/Prophet/Replica.pm	Sat Apr  5 19:47:20 2008
@@ -51,6 +51,9 @@
     # XXX TODO HACK NEED A PROPER WAY TO DETERMINE SYNC SOURCE
     if ( $args->{url} =~ /^rt:/ ) {
         $class = 'Prophet::Replica::RT';
+    }
+    elsif ($args->{url} =~ /^hiveminder:/ ) {
+        $class = 'Prophet::Replica::Hiveminder';
     } else {
         $class = 'Prophet::Replica::SVN';
     }

Modified: SVN-PropDB/lib/Prophet/Replica/Hiveminder.pm
==============================================================================
--- SVN-PropDB/lib/Prophet/Replica/Hiveminder.pm	(original)
+++ SVN-PropDB/lib/Prophet/Replica/Hiveminder.pm	Sat Apr  5 19:47:20 2008
@@ -32,7 +32,7 @@
 
 sub setup {
     my $self = shift;
-    my ( $server, $type, $query ) = $self->{url} =~ m/^hiveminder:(.*?)\|(.*?)\|(.*)$/
+    my ( $server, $type, $query ) = $self->{url} =~ m/^hiveminder:(.*?)$/
         or die "Can't parse hiveminder server spec";
     my $uri = URI->new($server);
     my ( $username, $password );

Modified: SVN-PropDB/lib/Prophet/Test.pm
==============================================================================
--- SVN-PropDB/lib/Prophet/Test.pm	(original)
+++ SVN-PropDB/lib/Prophet/Test.pm	Sat Apr  5 19:47:20 2008
@@ -134,6 +134,7 @@
 our $RUNCNT;
 
 sub _get_perl_cmd {
+    my $base_dir = Path::Class::file->new($0)->dir->parent->subdir('bin');
     my $script = shift;
     my @cmd = ( $^X, ( map {"-I$_"} @INC ) );
     push @cmd, '-MDevel::Cover' if $INC{'Devel/Cover.pm'};
@@ -141,7 +142,8 @@
         push @cmd, '-d:DProf';
         $ENV{'PERL_DPROF_OUT_FILE_NAME'} = 'tmon.out.' . $$ . '.' . $RUNCNT++;
     }
-    push @cmd, 'bin/' . $script;
+    warn $base_dir->file( $script );
+    push @cmd, $base_dir->file( $script );
     return @cmd;
 }
 

Added: SVN-PropDB/t/sd-hm.t
==============================================================================
--- (empty file)
+++ SVN-PropDB/t/sd-hm.t	Sat Apr  5 19:47:20 2008
@@ -0,0 +1,32 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+use Prophet::Test tests => 3;
+
+# you need to run this test script from the BTDT directory
+
+eval 'use BTDT::Test; 1;'
+    or plan skip_all => 'requires 3.7 to run tests.'.$@;
+
+my $server = BTDT::Test->make_server;
+my $URL = $server->started_ok;
+
+ok(1, "Loaded the test script");
+
+my $GOODUSER = BTDT::CurrentUser->new( email => 'gooduser at example.com' );
+my $task = BTDT::Model::Task->new(current_user => $GOODUSER);
+$task->create(
+    summary => "Fly Man",
+    description => '',
+);
+
+diag $task->id;
+my ($ret, $out, $err);
+
+my $sd_rt_url = "hiveminder:$URL";
+
+($ret, $out, $err) = run_script('sd', ['pull', $sd_rt_url]);
+diag $err;
+
+my ($yatta_uuid, $flyman_uuid);
+run_output_matches('sd', ['ticket', '--list', '--regex', '.'], [qr/(.*?)(?{ $flyman_uuid = $1 }) Fly Man (.*)/]);