[Catalyst-commits] r9450 - in trunk/examples/SmokeServer: . lib/SmokeServer/Controller lib/SmokeServer/Model lib/Test/TAP/Model script

t0m at dev.catalyst.perl.org t0m at dev.catalyst.perl.org
Sat Mar 7 19:12:38 GMT 2009


Author: t0m
Date: 2009-03-07 19:12:37 +0000 (Sat, 07 Mar 2009)
New Revision: 9450

Modified:
   trunk/examples/SmokeServer/
   trunk/examples/SmokeServer/Makefile.PL
   trunk/examples/SmokeServer/lib/SmokeServer/Controller/Smoke.pm
   trunk/examples/SmokeServer/lib/SmokeServer/Model/SmokeDB.pm
   trunk/examples/SmokeServer/lib/Test/TAP/Model/Smoke.pm
   trunk/examples/SmokeServer/script/smokeserver_upload.pl
Log:
And it works again. Make the script a little more helpful, require new dbic


Property changes on: trunk/examples/SmokeServer
___________________________________________________________________
Name: svn:ignore
   - META.yml
pm_to_blib
blib
inc
Makefile

   + cat_test_smoke.db
META.yml
pm_to_blib
blib
inc
Makefile


Modified: trunk/examples/SmokeServer/Makefile.PL
===================================================================
--- trunk/examples/SmokeServer/Makefile.PL	2009-03-07 17:04:00 UTC (rev 9449)
+++ trunk/examples/SmokeServer/Makefile.PL	2009-03-07 19:12:37 UTC (rev 9450)
@@ -4,7 +4,7 @@
 all_from 'lib/SmokeServer.pm';
 
 requires Catalyst => '5.64';
-requires 'DBIx::Class' => '0.06999_02';
+requires 'DBIx::Class' => '0.08012';
 requires 'Test::TAP::HTMLMatrix' => '0.05';
 requires 'HTML::TagCloud' => '0';
 requires 'Text::Tags' => '0';

Modified: trunk/examples/SmokeServer/lib/SmokeServer/Controller/Smoke.pm
===================================================================
--- trunk/examples/SmokeServer/lib/SmokeServer/Controller/Smoke.pm	2009-03-07 17:04:00 UTC (rev 9449)
+++ trunk/examples/SmokeServer/lib/SmokeServer/Controller/Smoke.pm	2009-03-07 19:12:37 UTC (rev 9450)
@@ -84,10 +84,6 @@
     my $smoke_rs : Stashed;
     my $tag_rs = $smoke_rs->related_resultset("smoke_tags")->related_resultset("tag");
 
-    #### ATHIOUJDHSTKALJHT ALKJT ! FUCK XXX TODO FIXME
-    $tag_rs->{cond}{"tag_2.name"} = delete $tag_rs->{cond}{"tag.name"};
-
-
     # filter ignored tags
     my $ignored_tags = $c->session->{ignored_tags_cloud};
     $tag_rs = $tag_rs->search({
@@ -163,9 +159,12 @@
     # FIXME this is really unsafe
     # the serializer could be Data::Dumper
     if ( my $smoke = eval { Data::Serializer->new->deserialize( $c->req->param("smoke_report") ) } ) {
-        $c->model("SmokeDB")->add_smoke( $smoke );
+        $c->log->debug("Added smoke");
+        my $smoke = $c->model("SmokeDB")->add_smoke( $smoke );
+        $c->log->debug("Smoke $smoke");
         $c->res->body("OK");
     } else {
+        $c->log->debug("Add smoke fail");
         $c->res->status(500);
         $c->res->body("bad dog no no");
     }

Modified: trunk/examples/SmokeServer/lib/SmokeServer/Model/SmokeDB.pm
===================================================================
--- trunk/examples/SmokeServer/lib/SmokeServer/Model/SmokeDB.pm	2009-03-07 17:04:00 UTC (rev 9449)
+++ trunk/examples/SmokeServer/lib/SmokeServer/Model/SmokeDB.pm	2009-03-07 19:12:37 UTC (rev 9450)
@@ -13,7 +13,7 @@
     connect_info => [
         'dbi:SQLite:dbname=' . SmokeServer->path_to('cat_test_smoke.db'),
         '', '',
-        { AutoCommit => 0 },
+        { AutoCommit => 1 }, # FIXME
         { on_connect_do => [ 'PRAGMA synchronous = OFF' ] },
     ],
 );

Modified: trunk/examples/SmokeServer/lib/Test/TAP/Model/Smoke.pm
===================================================================
--- trunk/examples/SmokeServer/lib/Test/TAP/Model/Smoke.pm	2009-03-07 17:04:00 UTC (rev 9449)
+++ trunk/examples/SmokeServer/lib/Test/TAP/Model/Smoke.pm	2009-03-07 19:12:37 UTC (rev 9450)
@@ -62,7 +62,7 @@
 
 sub upload {
     my ( $self, $uri ) = @_;
-    $self->lwp->post( $uri, { smoke_report => $self->serialized } ); 
+    $self->lwp->post( $uri, { smoke_report => $self->serialized } );
 }
 
 __PACKAGE__;

Modified: trunk/examples/SmokeServer/script/smokeserver_upload.pl
===================================================================
--- trunk/examples/SmokeServer/script/smokeserver_upload.pl	2009-03-07 17:04:00 UTC (rev 9449)
+++ trunk/examples/SmokeServer/script/smokeserver_upload.pl	2009-03-07 19:12:37 UTC (rev 9450)
@@ -9,9 +9,25 @@
 use Test::TAP::Model;
 use Test::TAP::Model::Smoke;
 
+die("$0 http://smokeserver:3000 /home/me/project_checkout") unless scalar(@ARGV) == 2;
+
 my $uri = shift;
+my $project = shift;
 
-my $model = Test::TAP::Model->new_with_tests( @ARGV );
+# Eugh, horrible horrible hacky mess.
+lib->import("$project/lib");
+chdir($project);
+system("cd $project ; perl Makefile.PL") && do { warn("Project $project Makefile.PL non zero exit status"); exit 1 };
+system("cd $project; make installdeps");
+my $model = Test::TAP::Model->new_with_tests( glob("$project/t/*.t") );
 my $report = Test::TAP::Model::Smoke->new( $model, qw/milk elk tag1/);
 
-exit $report->upload($uri)->code == 200 ? 0 : 1;
+my $result = $report->upload($uri . "/upload");
+my $exp_body = "OK";
+
+unless ($result->code == 200 && $result->content eq $exp_body) {
+    warn("Error " . $result->content . "\n");
+    exit 1;
+}
+exit 0;
+


Property changes on: trunk/examples/SmokeServer/script/smokeserver_upload.pl
___________________________________________________________________
Name: svn:executable
   + *




More information about the Catalyst-commits mailing list