Merge pull request #80 from HebaruSan/fix/status-locks

Instant status updates from bot and webhooks

.travis.yml

@@ -1,7 +1,7 @@
 # thanks -> http://blogs.perl.org/users/alex_balhatchet/2013/04/travis-ci-perl.html
 language: perl
 perl:
-#  - "5.22" 
+#  - "5.22"
   - "5.20"
   - "5.18"
 addons:

lib/App/KSP_CKAN/NetKAN.pm

@@ -31,7 +31,7 @@ use namespace::clean;
 =head1 DESCRIPTION
 
 Is a wrapper for the NetKAN inflater. Initially it will
-just wrap and capture errors, but the intention is to 
+just wrap and capture errors, but the intention is to
 add helper methods to check for changes in remote meta
 data and only run the inflater when required.
 
@@ -77,7 +77,7 @@ method _mirror_files {
   my $config = $self->config;
 
   # netkan.exe
-  $self->_http->mirror( 
+  $self->_http->mirror(
     url   => $config->netkan_exe,
     path  => $config->working."/netkan.exe",
     exe   => 1,
@@ -104,7 +104,10 @@ method _inflate_all(:$rescan = 1) {
   $self->_CKAN_meta->pull;
   $self->_NetKAN->pull;
   local $CWD = $self->config->working."/".$self->_NetKAN->working;
-  foreach my $file (glob("NetKAN/*.netkan")) {
+
+  my @files = glob("NetKAN/*.netkan");
+  $self->_status->prune_missing(map { ($_ =~ m{([^/.]+)\.netkan$})[0] } @files);
+  foreach my $file (@files) {
     my $netkan = App::KSP_CKAN::Tools::NetKAN->new(
       config      => $self->config,
       file        => $file,
@@ -138,7 +141,7 @@ method _push {
   return;
 }
 
-=method full_index 
+=method full_index
 
 Performs a full index of the NetKAN metadata and pushes
 it into CKAN-meta (or whichever repository is configured)
@@ -151,7 +154,6 @@ method full_index {
   $self->_update_download_counts;
   if ( ! $self->is_debug() ) {
     $self->_push;
-    $self->_status->write_json;
   }
   return;
 }
@@ -171,7 +173,6 @@ method lite_index {
   $self->_inflate_all( rescan => 0 );
   if ( ! $self->is_debug() ) {
     $self->_push;
-    $self->_status->write_json;
   }
   return;
 }

lib/App/KSP_CKAN/Status.pm

@@ -6,6 +6,7 @@ use warnings;
 use autodie;
 use Method::Signatures 20140224;
 use Carp qw( croak );
+use IO::LockedFile;
 use File::Slurper qw(read_text write_text);
 use Try::Tiny;
 use JSON;
@@ -29,7 +30,7 @@ use namespace::clean;
 
 =head1 DESCRIPTION
 
-Status object for tracking status of at least initially, NetKAN 
+Status object for tracking status of at least initially, NetKAN
 indexing.
 
 =cut
@@ -42,20 +43,8 @@ has 'config'        => ( is => 'ro', required => 1, isa => $Ref );
 has 'status_file'   => ( is => 'ro', default => sub { "netkan.json" } );
 has 'status_path'   => ( is => 'ro', lazy => 1, builder => 1 );
 has '_status_file'  => ( is => 'ro', lazy => 1, builder => 1 );
-has '_data'         => ( is => 'ro', lazy => 1, builder => 1 );
 has '_json'         => ( is => 'ro', lazy => 1, builder => 1 );
 
-has 'status' => ( 
-  is            => 'rw',
-  handles_via   => 'Hash',
-  handles       => {
-    get_val   => 'get',
-    set_val   => 'set',
-    all_keys  => 'keys'
-  },
-  default       => sub { { } }, 
-);
-
 method _build__json {
   return JSON->new->allow_blessed(1)->convert_blessed(1);
 }
@@ -72,7 +61,7 @@ method _build__status_file {
   return $self->status_path."/".$self->status_file;
 }
 
-method _build__data {
+method _get_data() {
   my $raw;
   if (! -e $self->_status_file) {
     $raw = "{}";
@@ -90,6 +79,29 @@ method _build__data {
   return $data;
 }
 
+method _with_status($func) {
+  # Open file with flock locking to manage concurrent access
+  # This will block till it's our turn to be exclusive with the file
+  my $fh = IO::LockedFile->new($self->_status_file, 'a+');
+
+  # Load file contents and deserialize to JSON object
+  my $data = $self->_json->decode(join('', <$fh>) || '{}');
+
+  # Process the JSON object through function given in $func param
+  my $new_data = $func->($data);
+
+  # Clear the file so we can replace its contents
+  $fh->truncate(0);
+
+  # Jump back to beginning
+  $fh->seek(0, 0);
+
+  # Print new data to the file
+  print $fh $self->_json->encode($new_data);
+
+  # Lock will be released when $fh passes out of scope (now)
+}
+
 =method get_status
 
   my $netkan_status = $status->get_status( "BaconLabs" );
@@ -100,25 +112,48 @@ it if necessary or loading it from the available data if it exists.
 =cut
 
 method get_status($name) {
-  if ($self->_data->{$name}) {
-    $self->set_val($name, App::KSP_CKAN::Status::NetKAN->new($self->_data->{$name}));
-  } else {
-    $self->set_val($name, App::KSP_CKAN::Status::NetKAN->new(name => $name));
-  }
-  return $self->get_val($name);
+  my $data = $self->_get_data();
+  return $data->{$name}
+    ? App::KSP_CKAN::Status::NetKAN->new($data->{$name})
+    : App::KSP_CKAN::Status::NetKAN->new(name => $name);
 }
 
-=method write_json
-  
-  $status->write_json
+=method prune_missing
+
+  $status->prune_missing(@identifiers)
+
+Removes from the status file any entries that aren't in the input list
+
+=cut
+
+# Remove the status entries that aren't in the input list
+# This allows us to preserve ALL previous entries in later updates
+method prune_missing(@identifiers) {
+  $self->_with_status(sub {
+    my $data = shift;
+    my $new_data = {};
+    # For simplicity, just copy across the ones that ARE in the input
+    foreach my $id (@identifiers) {
+      $new_data->{$id} = $data->{$id};
+    }
+    return $new_data;
+  });
+}
+
+=method update_status
+
+  $status->update_status($id, $status)
 
-Writes our status file out to disk.
+Set a module's status object to the given value
 
 =cut
 
-method write_json {
-  my $json = $self->_json->encode($self->status);
-  write_text($self->_status_file, $json);
+method update_status($id, $status) {
+  $self->_with_status(sub {
+    my $data = shift;
+    $data->{$id} = $status;
+    return $data;
+  });
 }
 
 1;

lib/App/KSP_CKAN/Tools/NetKAN.pm

@@ -37,7 +37,7 @@ use namespace::clean;
 =head1 DESCRIPTION
 
 Is a wrapper for the NetKAN inflater. Initially it will
-just wrap and capture errors, but the intention is to 
+just wrap and capture errors, but the intention is to
 add helper methods to check for changes in remote meta
 data and only run the inflater when required.
 
@@ -172,14 +172,14 @@ method _commit($file) {
     $self->ckan_meta->clean_untracked;
     $self->_status->failure("Schema validation failed");
     return 1;
-  } 
-  
+  }
+
   if ($self->is_debug()) {
     $self->debug("$changed would have been committed");
     $self->ckan_meta->reset(file => $file);
     return 0;
-  } 
-  
+  }
+
   if ( ! $self->_netkan_metadata->staging ) {
     $self->info("Committing $changed");
     $self->ckan_meta->commit(
@@ -204,8 +204,12 @@ method _commit($file) {
   return 1;
 }
 
+method _save_status() {
+  $self->status->update_status($self->_basename, $self->_status);
+}
+
 =method inflate
-  
+
   $netkan->inflate;
 
 Inflates our metadata.
@@ -216,34 +220,39 @@ method inflate {
   $self->_status->checked;
 
   if (! $self->rescan ) {
+    $self->_save_status();
     return;
   }
-  
+
   # We won't know if NetKAN actually made a change and
   # it doesn't know either, it just produces a ckan file.
   # This gives us a hash of all files in the directory
   # before we inflate to compare afterwards.
   my $md5 = $self->_output_md5;
 
   $self->debug("Inflating ".$self->file);
-  my ($stderr, $stdout, $exit) = capture { 
+  my ($stderr, $stdout, $exit) = capture {
     system($self->_cli);
   };
 
   $self->_status->inflated;
 
-  if ($exit) { 
-    my $error = $stdout ? $self->_parse_error($stdout) : $self->_parse_error($stderr); 
+  if ($exit) {
+    my $error = $stdout ? $self->_parse_error($stdout) : $self->_parse_error($stderr);
     $self->warn("'".$self->file."' - ".$error);
     $self->_status->failure($error);
+    $self->_save_status();
     return $exit;
   }
 
   if ($md5 ne $self->_output_md5) {
-    return $self->_commit($self->_newest_file);
+    my $ret = $self->_commit($self->_newest_file);
+    $self->_save_status();
+    return $ret;
   }
 
   $self->_status->success;
+  $self->_save_status();
   return 0;
 }
 

t/App/KSP_CKAN/Status.t

@@ -34,7 +34,7 @@ $netkan->checked;
 my $inflated = $netkan->last_inflated;
 my $indexed = $netkan->last_indexed;
 my $checked = $netkan->last_checked;
-$status->write_json;
+$status->update_status("TestKAN", $netkan);
 
 is(-e $status->_status_file, 1, "Status file written");
 

t/App/KSP_CKAN/Tools/NetKAN.t

@@ -53,7 +53,7 @@ $http->mirror( url => $config->ckan_schema, path => $config->working."/CKAN.sche
 
 use_ok("App::KSP_CKAN::Tools::NetKAN");
 my $netkan = App::KSP_CKAN::Tools::NetKAN->new(
-  config    => $config, 
+  config    => $config,
   netkan    => $test->tmp."/netkan.exe",
   cache     => $test->tmp."/cache", # TODO: Test default cache location
   ckan_meta => $ckan,
@@ -64,7 +64,7 @@ my $netkan = App::KSP_CKAN::Tools::NetKAN->new(
 # TODO: Fix this on travis.
 TODO: {
    todo_skip "These tests are broken on travis", 7 if $ENV{TRAVIS};
-  
+
   my $md5 = $netkan->_output_md5;
   isnt($md5, undef, "MD5 '$md5' generated");
   is( $netkan->inflate, 0, "Return success correctly" );
@@ -73,9 +73,9 @@ TODO: {
   my @files = glob($config->working."/CKAN-meta/DogeCoinFlag/*");
   is( -e $files[0], 1, "Meta Data inflated" );
   is( $files[0], $netkan->_newest_file, "'".$netkan->_newest_file."' returned as the newest file");
-  
-  $netkan = App::KSP_CKAN::Tools::NetKAN->new( 
-    config    => $config, 
+
+  $netkan = App::KSP_CKAN::Tools::NetKAN->new(
+    config    => $config,
     netkan    => $test->tmp."/netkan.exe",
     cache     => $test->tmp."/cache",
     ckan_meta => $ckan,
@@ -84,14 +84,6 @@ TODO: {
   );
   isnt( $netkan->inflate, 0, "Return failure correctly" );
 
-  subtest 'Status Setting' => sub {
-    like($status->status->{'DogeCoinFlag-broken'}{last_error}, qr/Required property 'version' not found/, "'last_error' set on failure");
-    is($status->status->{'DogeCoinFlag-broken'}{failed}, 1, "'failed' true on failure");
-    is($status->status->{'DogeCoinFlag-broken'}{last_indexed}, undef, "'last_index' undef when no successful indexing has ever occured");
-    is($status->status->{'DogeCoinFlag'}{last_error}, undef, "'last_error' undef on success");
-    is($status->status->{'DogeCoinFlag'}{failed}, 0, "'failed' false on succes");
-  };
-
   ok( -d $test->tmp."/cache", "NetKAN Cache path set correctly");
 }
 
@@ -113,7 +105,7 @@ subtest 'File Validation' => sub {
 subtest 'Staged Commits' => sub {
   # Setup
   my $staged = App::KSP_CKAN::Tools::NetKAN->new(
-    config    => $config, 
+    config    => $config,
     netkan    => $test->tmp."/netkan.exe",
     cache     => $test->tmp."/cache", # TODO: Test default cache location
     ckan_meta => $ckan,
@@ -153,35 +145,35 @@ subtest 'Error Parsing' => sub {
     "Could not find CrowdSourcedScience directory in zipfile to install",
     "Zipfile Error Parsing Success"
   );
-  
+
   is (
     $netkan->_parse_error("2142 [1] FATAL CKAN.NetKAN.Program (null) - JSON deserialization error"),
     "JSON deserialization error",
     "JSON Error Parsing Success"
   );
-  
+
   my $error = <<EOF;
 Unhandled Exception:
 CKAN.Kraken: Cannot find remote and ID in kref: http://dl.dropboxusercontent.com/u/7121093/ksp-mods/KSP%5B1.0.2%5DWasdEditorCamera%5BMay20%5D.zip
-  at CKAN.NetKAN.MainClass.FindRemote (Newtonsoft.Json.Linq.JObject json) [0x00000] in <filename unknown>:0 
-  at CKAN.NetKAN.MainClass.Main (System.String[] args) [0x00000] in <filename unknown>:0 
+  at CKAN.NetKAN.MainClass.FindRemote (Newtonsoft.Json.Linq.JObject json) [0x00000] in <filename unknown>:0
+  at CKAN.NetKAN.MainClass.Main (System.String[] args) [0x00000] in <filename unknown>:0
 [ERROR] FATAL UNHANDLED EXCEPTION: CKAN.Kraken: Cannot find remote and ID in kref: http://dl.dropboxusercontent.com/u/7121093/ksp-mods/KSP%5B1.0.2%5DWasdEditorCamera%5BMay20%5D.zip
-  at CKAN.NetKAN.MainClass.FindRemote (Newtonsoft.Json.Linq.JObject json) [0x00000] in <filename unknown>:0 
-  at CKAN.NetKAN.MainClass.Main (System.String[] args) [0x00000] in <filename unknown>:0 
+  at CKAN.NetKAN.MainClass.FindRemote (Newtonsoft.Json.Linq.JObject json) [0x00000] in <filename unknown>:0
+  at CKAN.NetKAN.MainClass.Main (System.String[] args) [0x00000] in <filename unknown>:0
 EOF
-  
+
   is (
     $netkan->_parse_error( $error ),
     "FATAL UNHANDLED EXCEPTION: CKAN.Kraken: Cannot find remote and ID in kref: http://dl.dropboxusercontent.com/u/7121093/ksp-mods/KSP%5B1.0.2%5DWasdEditorCamera%5BMay20%5D.zip",
     "Generic Error Parsing Success"
   );
-  
+
   is (
     $netkan->_parse_error("791 [1] WARN CKAN.Curl (null) - Curl environment not pre-initialised, performing non-threadsafe init.\n8194 [1] FATAL CKAN.NetKAN.Program (null) - Could not find CrowdSourcedScience directory in zipfile to install"),
     "Could not find CrowdSourcedScience directory in zipfile to install",
     "Mutliline Fatal Success"
   );
-  
+
   is (
     $netkan->_parse_error( "Cookie Cat Crystal Combo powers... ACTIVATE" ),
     "Error wasn't parsable",