[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