Cleanup: Mojo-ize old code, simplifying perl OO code
Make Sql Storage inherit Filesystem, since the DB is only used as an index and still stores on disk
--- a/CrashTest.pl Mon Aug 04 15:45:02 2014 +0200
+++ b/CrashTest.pl Thu Aug 07 23:50:08 2014 +0200
@@ -27,14 +27,30 @@
app->attr(storage => sub {
my $self = shift;
- eval "require $config->{Storage}->{Type}" or die "Loading module failed $@";
- return $config->{Storage}->{Type}->new($config->{Storage});
+ my $loader = Mojo::Loader->new;
+
+ my $storage_class = $self->app->config->{Storage}->{Type};
+ if (my $e = $loader->load($storage_class)) {
+ die ref $e ? "Exception: $e" : 'Not found!';
+ }
+
+ return $storage_class->new(config => $self->app->config->{Storage});
});
app->attr(decode_queue => sub {
my $self = shift;
- eval "require $config->{DecodeQueue}->{Type}" or die "Loading module failed $@";
- return $config->{DecodeQueue}->{Type}->new($config->{DecodeQueue}, $config->{Dumper}, app->storage);
+ my $loader = Mojo::Loader->new;
+
+ my $decode_class = $self->app->config->{DecodeQueue}->{Type};
+ if (my $e = $loader->load($decode_class)) {
+ die ref $e ? "Exception: $e" : 'Not found!';
+ }
+
+ return $decode_class->new(
+ config => $self->app->config->{DecodeQueue},
+ dumper_config => $self->app->config->{Dumper},
+ storage => $self->app->storage
+ );
});
helper scm_file_link => sub {
--- a/bin/gearman_decode_worker.pl Mon Aug 04 15:45:02 2014 +0200
+++ b/bin/gearman_decode_worker.pl Thu Aug 07 23:50:08 2014 +0200
@@ -16,6 +16,7 @@
use Gearman::Worker;
use Mojo::JSON;
use Mojo::Util qw(decode slurp);
+use Mojo::Loader;
use File::Temp;
use lib 'lib';
@@ -27,8 +28,14 @@
my $config = load_config($ARGV[0]);
-eval "require $config->{Storage}->{Type}";
-my $storage = $config->{Storage}->{Type}->new($config->{Storage});
+my $loader = Mojo::Loader->new;
+
+my $storage_class = $config->{Storage}->{Type};
+if (my $e = $loader->load($storage_class)) {
+ die ref $e ? "Exception: $e" : 'Not found!';
+}
+
+my $storage = $storage_class->new(config => $config->{Storage});
my $worker = Gearman::Worker->new(job_servers => $config->{DecodeQueue}->{GearmanServers});
--- a/lib/CrashTest/Decode/Queue/Gearman.pm Mon Aug 04 15:45:02 2014 +0200
+++ b/lib/CrashTest/Decode/Queue/Gearman.pm Thu Aug 07 23:50:08 2014 +0200
@@ -12,14 +12,18 @@
# along with this program. If not, see <http://www.gnu.org/licenses/>.
package CrashTest::Decode::Queue::Gearman;
-use Mojo::Base -strict;
+use Mojo::Base -base;
use Gearman::Client;
+has [ qw/config gearman/ ];
+
sub new {
- my ($class, $config, $dumperconfig, $storage) = @_;
- my $self = {};
- $self->{gearman} = Gearman::Client->new(job_servers => $config->{GearmanServers});
- bless ($self, $class);
+ my $self = shift->SUPER::new(@_);
+
+ $self->gearman(Gearman::Client->new(
+ job_servers => $self->config->{GearmanServers})
+ );
+
return $self;
}
@@ -27,10 +31,17 @@
my ($self, $file, $paramshash, $uuidstr, $cb) = @_;
my $json = Mojo::JSON->new;
- my $args = $json->encode({ file => $file->slurp, params => $paramshash, uuid => $uuidstr });
- $self->{gearman}->dispatch_background('dump_decode', $args);
+ my $args = $json->encode(
+ {
+ file => $file->slurp,
+ params => $paramshash,
+ uuid => $uuidstr
+ }
+ );
- &$cb({ status => "backgrounded" });
+ $self->gearman->dispatch_background('dump_decode', $args);
+
+ $cb->({ status => "backgrounded" });
}
1;
--- a/lib/CrashTest/Decode/Queue/NoQueue.pm Mon Aug 04 15:45:02 2014 +0200
+++ b/lib/CrashTest/Decode/Queue/NoQueue.pm Thu Aug 07 23:50:08 2014 +0200
@@ -12,40 +12,38 @@
# along with this program. If not, see <http://www.gnu.org/licenses/>.
package CrashTest::Decode::Queue::NoQueue;
-
+use Mojo::Base -base;
use File::Temp;
-use strict;
-use warnings;
+has [ qw/config dumper_config storage/ ];
sub new {
- my ($class, $config, $dumperconfig, $storage) = @_;
- my $self = {};
- $self->{Dumper} = $dumperconfig;
- $self->{storage} = $storage;
- bless ($self, $class);
+ my $self = shift->SUPER::new(@_);
+
return $self;
}
sub decode {
my ($self, $file, $paramshash, $uuidstr, $cb) = @_;
+
my $fh = File::Temp->new(SUFFIX => '.dmp');
my $dmp_file = $fh->filename;
$file->move_to($dmp_file);
- my $cmd = $self->{Dumper}->{JSONStackwalker} . " $dmp_file " . $self->{Dumper}->{SymbolsPath};
+ my $cmd = $self->dumper_config->{JSONStackwalker} . " $dmp_file " . $self->dumper_config->{SymbolsPath};
my $out = qx($cmd 2>/dev/null) or die $!;
my $json = Mojo::JSON->new;
my $pjson = $json->decode($out);
# Create json for the params
+ # TODO check for authorised values ...
$pjson->{client_info} = $paramshash;
- $self->{storage}->store_dump($uuidstr, $file->slurp);
- $self->{storage}->store_processed_data($uuidstr, $pjson);
+ $self->storage->store_dump($uuidstr, $file->slurp);
+ $self->storage->store_processed_data($uuidstr, $pjson);
- &$cb($pjson);
+ $cb->($pjson);
}
1;
--- a/lib/CrashTest/Storage/FileSystem.pm Mon Aug 04 15:45:02 2014 +0200
+++ b/lib/CrashTest/Storage/FileSystem.pm Thu Aug 07 23:50:08 2014 +0200
@@ -12,15 +12,18 @@
# along with this program. If not, see <http://www.gnu.org/licenses/>.
package CrashTest::Storage::FileSystem;
-use Mojo::Base -strict;
+use Mojo::Base -base;
+use Mojo::Util qw/slurp spurt/;
use DateTime;
use Data::Page;
+has [ qw/config data_path/ ];
+
sub new {
- my ($class, $config) = @_;
- my $self = {};
- $self->{data_path} = $config->{DataDir};
- bless ($self, $class);
+ my $self = shift->SUPER::new(@_);
+
+ $self->data_path($self->config->{DataDir});
+
return $self;
}
@@ -29,11 +32,11 @@
my @files;
my $dh;
- opendir($dh, $self->{data_path}) or die $!;
+ opendir($dh, $self->data_path) or die $!;
my @allfiles = readdir $dh;
foreach(@allfiles) {
if($_ =~ /(.*)\.json$/) {
- my $filename = File::Spec->catfile($self->{data_path}, $_);
+ my $filename = File::Spec->catfile($self->data_path, $_);
if(-f $filename) {
push @files, {
file => $filename,
@@ -48,9 +51,8 @@
}
closedir $dh;
- my @sorted_files = sort {
- $b->{date} <=> $a->{date}
- } @files;
+ sub by_date { $b->{date} <=> $a->{date} };
+ my @sorted_files = sort by_date @files;
my $pager = Data::Page->new();
$pager->total_entries(scalar @files);
@@ -81,10 +83,8 @@
sub get_processed_data {
my ($self, $uuid) = @_;
- open JSON, '<', File::Spec->catfile($self->{data_path}, $uuid . '.json') or die $!;
- my @json_content_lines = <JSON>;
- my $json_content = join('', @json_content_lines);
- close JSON;
+ my $jsonfilename = File::Spec->catfile($self->data_path, "$uuid.json");
+ my $json_content = slurp($jsonfilename) or die $!;
my $json = Mojo::JSON->new;
my $processed_data = $json->decode($json_content);
@@ -95,20 +95,23 @@
sub store_processed_data {
my ($self, $uuid, $pjson) = @_;
+ my $jsonfilename = File::Spec->catfile($self->data_path, "$uuid.json");
+ my $dmpfilename = File::Spec->catfile($self->data_path, "$uuid.dmp");
+
my $json = Mojo::JSON->new;
- my $j = $json->encode($pjson);
- open JSON, '>', File::Spec->catfile($self->{data_path}, "$uuid.json") or die $!;
- print JSON $j;
- close JSON;
- utime $pjson->{client_info}->{CrashTime}, $pjson->{client_info}->{CrashTime}, File::Spec->catfile($self->{data_path}, "$uuid.json");
- utime $pjson->{client_info}->{CrashTime}, $pjson->{client_info}->{CrashTime}, File::Spec->catfile($self->{data_path}, "$uuid.dmp");
+ spurt($json->encode($pjson), $jsonfilename) or die $!;
+ # Set time of the .dmp to the CrashTime
+ my $crashtime = $pjson->{client_info}->{CrashTime};
+ if(defined($crashtime)) {
+ utime $crashtime, $crashtime, $dmpfilename;
+ }
}
sub store_dump {
my ($self, $uuid, $file) = @_;
- my $dmp_file = File::Spec->catfile($self->{data_path}, "$uuid.dmp");
+ my $dmp_file = File::Spec->catfile($self->data_path, "$uuid.dmp");
my $fh = IO::File->new($dmp_file, "w") or die($!);
$fh->binmode;
print $fh $file;
--- a/lib/CrashTest/Storage/Sql.pm Mon Aug 04 15:45:02 2014 +0200
+++ b/lib/CrashTest/Storage/Sql.pm Thu Aug 07 23:50:08 2014 +0200
@@ -12,18 +12,15 @@
# along with this program. If not, see <http://www.gnu.org/licenses/>.
package CrashTest::Storage::Sql;
-use Mojo::Base -strict;
+use Mojo::Base "CrashTest::Storage::FileSystem";
use DateTime;
use CrashTest::Storage::Sql::Schema;
sub new {
- my ($class, $config) = @_;
- my $self = {};
+ my $self = shift->SUPER::new(@_);
- $self->{data_path} = $config->{DataDir};
- $self->{schema} = CrashTest::Storage::Sql::Schema->connect($config->{DSN});
+ $self->{schema} = CrashTest::Storage::Sql::Schema->connect($self->config->{DSN});
- bless ($self, $class);
return $self;
}
@@ -59,20 +56,6 @@
return $results;
}
-sub get_processed_data {
- my ($self, $uuid) = @_;
-
- open JSON, '<', File::Spec->catfile($self->{data_path}, $uuid . '.json') or die $!;
- my @json_content_lines = <JSON>;
- my $json_content = join('', @json_content_lines);
- close JSON;
-
- my $json = Mojo::JSON->new;
- my $processed_data = $json->decode($json_content);
-
- return $processed_data;
-}
-
sub _db_insert_processed_data {
my ($self, $uuid, $pjson) = @_;
@@ -126,23 +109,9 @@
sub store_processed_data {
my ($self, $uuid, $pjson) = @_;
- my $json = Mojo::JSON->new;
- my $j = $json->encode($pjson);
- open JSON, '>', File::Spec->catfile($self->{data_path}, "$uuid.json") or die $!;
- print JSON $j;
- close JSON;
+ $self->SUPER::store_processed_data($uuid, $pjson);
$self->_db_insert_processed_data($uuid, $pjson);
}
-sub store_dump {
- my ($self, $uuid, $file) = @_;
-
- my $dmp_file = File::Spec->catfile($self->{data_path}, "$uuid.dmp");
- my $fh = IO::File->new($dmp_file, "w") or die($!);
- $fh->binmode;
- print $fh $file;
- undef $fh;
-}
-
1;