File Coverage

blib/lib/Schedule/LongSteps/Storage/Memory.pm
Criterion Covered Total %
statement 43 43 100.0
branch 5 6 83.3
condition 6 6 100.0
subroutine 9 9 100.0
pod 3 4 75.0
total 66 68 97.0


line stmt bran cond sub pod time code
1             package Schedule::LongSteps::Storage::Memory;
2             $Schedule::LongSteps::Storage::Memory::VERSION = '0.023';
3 14     14   63906 use Moose;
  14         379291  
  14         114  
4             extends qw/Schedule::LongSteps::Storage/;
5              
6 14     14   93675 use DateTime;
  14         363877  
  14         343  
7              
8 14     14   377 use Log::Any qw/$log/;
  14         5577  
  14         112  
9              
10             =head1 NAME
11              
12             Schedule::LongSteps::Storage::DBIxClass - DBIx::Class based storage.
13              
14             =head1 SYNOPSIS
15              
16             my $storage = Schedule::LongSteps::Storage::Memory->new();
17              
18             Then build and use a L<Schedule::LongSteps> object:
19              
20             my $long_steps = Schedule::LongSteps->new({ storage => $storage });
21              
22             ...
23              
24              
25             =cut
26              
27             has 'processes' => ( is => 'ro', isa => 'ArrayRef[Schedule::LongSteps::Storage::Memory::Process]', default => sub{ []; } );
28              
29             =head2 prepare_due_processes
30              
31             See L<Schedule::LongSteps::Storage>
32              
33             =cut
34              
35             sub prepare_due_processes{
36 42     42 1 541 my ($self) = @_;
37              
38 42         160 my $now = DateTime->now();
39 42         11401 my $uuid = $self->uuid()->create_str();
40              
41 42         117 my @to_run = ();
42 42         72 foreach my $process ( @{ $self->processes() } ){
  42         1306  
43 56 100 100     1537 if( $process->run_at()
      100        
44             && !$process->run_id()
45             && ( DateTime->compare( $process->run_at(), $now ) <= 0 ) ){
46 35         2900 $process->update({
47             run_id => $uuid,
48             status => 'running'
49             });
50 35         146 push @to_run , $process;
51             }
52             }
53 42         417 return @to_run;
54             }
55              
56             =head2 find_process
57              
58             See L<Schedule::LongSteps::Storage>
59              
60             =cut
61              
62             sub find_process{
63 19     19 1 46 my ($self, $pid) = @_;
64 19         113 $log->trace("Looking up process ID=$pid");
65 19         67 my ( $match ) = grep{ $_->id() == $pid } @{$self->processes()};
  30         788  
  19         542  
66 19 100       88 my $log_message = $match ? "Found: $match" : "Could not find a process for $pid";
67 19         64 $log->trace($log_message);
68 19         80 return $match;
69             }
70              
71              
72             =head2 create_process
73              
74             See L<Schedule::LongSteps::Storage>
75              
76             =cut
77              
78             sub create_process{
79 19     19 1 712 my ($self, $process_properties) = @_;
80 19         647 my $process = Schedule::LongSteps::Storage::Memory::Process->new($process_properties);
81 19         37 push @{$self->processes()} , $process;
  19         583  
82 19         79 return $process;
83             }
84              
85             __PACKAGE__->meta->make_immutable();
86              
87             package Schedule::LongSteps::Storage::Memory::Process;
88             $Schedule::LongSteps::Storage::Memory::Process::VERSION = '0.023';
89 14     14   8402 use Moose;
  14         39  
  14         68  
90              
91 14     14   83696 use DateTime;
  14         31  
  14         3285  
92              
93             my $IDSEQUENCE = 0;
94              
95             has 'id' => ( is => 'ro', isa => 'Int', default => sub{ ++$IDSEQUENCE ; } );
96             has 'process_class' => ( is => 'rw', isa => 'Str', required => 1); # rw only for test. Should not changed ever.
97             has 'status' => ( is => 'rw', isa => 'Str', default => 'pending' );
98             has 'what' => ( is => 'rw' , isa => 'Str', required => 1);
99             has 'run_at' => ( is => 'rw', isa => 'Maybe[DateTime]', default => sub{ undef; } );
100             has 'run_id' => ( is => 'rw', isa => 'Maybe[Str]', default => sub{ undef; } );
101             has 'state' => ( is => 'rw', default => sub{ {}; });
102             has 'error' => ( is => 'rw', isa => 'Maybe[Str]', default => sub{ undef; } );
103              
104             sub update{
105 72     72 0 455 my ($self, $update_properties) = @_;
106 72 50       186 defined($update_properties) or ( $update_properties = {} );
107              
108             # use Data::Dumper;
109             # warn "Updating with ".Dumper($update_properties);
110              
111 72         113 while( my ( $key, $value ) = each %{$update_properties} ){
  291         942  
112 219         6479 $self->$key( $value );
113             }
114             }
115              
116             __PACKAGE__->meta->make_immutable();