# HG changeset patch # User Vincent Tondellier # Date 1407448208 -7200 # Node ID e0d6597078a5514b4a8ce2e4b70cdf23a9b2ad8b # Parent da690d68c1ff8fc111992174791d966396a494f8 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 diff -r da690d68c1ff -r e0d6597078a5 CrashTest.pl --- 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 { diff -r da690d68c1ff -r e0d6597078a5 bin/gearman_decode_worker.pl --- 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}); diff -r da690d68c1ff -r e0d6597078a5 lib/CrashTest/Decode/Queue/Gearman.pm --- 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 . 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; diff -r da690d68c1ff -r e0d6597078a5 lib/CrashTest/Decode/Queue/NoQueue.pm --- 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 . 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; diff -r da690d68c1ff -r e0d6597078a5 lib/CrashTest/Storage/FileSystem.pm --- 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 . 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 = ; - 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; diff -r da690d68c1ff -r e0d6597078a5 lib/CrashTest/Storage/Sql.pm --- 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 . 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 = ; - 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;