| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Job::Async::Job; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 2 |  |  | 2 |  | 14 | use strict; | 
|  | 2 |  |  |  |  | 3 |  | 
|  | 2 |  |  |  |  | 52 |  | 
| 4 | 2 |  |  | 2 |  | 10 | use warnings; | 
|  | 2 |  |  |  |  | 3 |  | 
|  | 2 |  |  |  |  | 70 |  | 
| 5 |  |  |  |  |  |  |  | 
| 6 |  |  |  |  |  |  | our $VERSION = '0.004'; # VERSION | 
| 7 |  |  |  |  |  |  |  | 
| 8 |  |  |  |  |  |  | =head1 NAME | 
| 9 |  |  |  |  |  |  |  | 
| 10 |  |  |  |  |  |  | Job::Async::Job - represents a single job for L | 
| 11 |  |  |  |  |  |  |  | 
| 12 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 13 |  |  |  |  |  |  |  | 
| 14 |  |  |  |  |  |  | =head1 DESCRIPTION | 
| 15 |  |  |  |  |  |  |  | 
| 16 |  |  |  |  |  |  | =cut | 
| 17 |  |  |  |  |  |  |  | 
| 18 | 2 |  |  | 2 |  | 673 | use Sereal; | 
|  | 2 |  |  |  |  | 1593 |  | 
|  | 2 |  |  |  |  | 77 |  | 
| 19 | 2 |  |  | 2 |  | 695 | use JSON::MaybeUTF8 qw(:v1); | 
|  | 2 |  |  |  |  | 7782 |  | 
|  | 2 |  |  |  |  | 265 |  | 
| 20 |  |  |  |  |  |  |  | 
| 21 | 2 |  |  | 2 |  | 15 | use constant SEREAL_DEFAULT => 1; | 
|  | 2 |  |  |  |  | 3 |  | 
|  | 2 |  |  |  |  | 970 |  | 
| 22 |  |  |  |  |  |  |  | 
| 23 |  |  |  |  |  |  | my $sereal_encode = Sereal::Encoder->new; | 
| 24 |  |  |  |  |  |  | my $sereal_decode = Sereal::Decoder->new; | 
| 25 |  |  |  |  |  |  |  | 
| 26 | 0 |  |  | 0 | 0 | 0 | sub id { shift->{id} } | 
| 27 |  |  |  |  |  |  |  | 
| 28 |  |  |  |  |  |  | sub data { | 
| 29 | 5064 |  |  | 5064 | 0 | 6573 | my ($self, $key) = @_; | 
| 30 | 5064 | 50 |  |  |  | 7083 | return $self->{data} unless defined $key; | 
| 31 | 5064 |  |  |  |  | 9103 | return $self->{data}{$key}; | 
| 32 |  |  |  |  |  |  | } | 
| 33 |  |  |  |  |  |  |  | 
| 34 |  |  |  |  |  |  | sub encode_keypair { | 
| 35 | 0 |  |  | 0 | 0 | 0 | my ($self, $k, $v) = @_; | 
| 36 | 0 | 0 |  |  |  | 0 | return !ref($v) | 
| 37 |  |  |  |  |  |  | ? ("text_$k" => $v) | 
| 38 |  |  |  |  |  |  | : SEREAL_DEFAULT | 
| 39 |  |  |  |  |  |  | ? ("sereal_$k" => $sereal_encode->encode($v)) | 
| 40 |  |  |  |  |  |  | : ("json_$k" => encode_json_utf8($v)) | 
| 41 |  |  |  |  |  |  | } | 
| 42 |  |  |  |  |  |  |  | 
| 43 |  |  |  |  |  |  | sub flattened_data { | 
| 44 | 0 |  |  | 0 | 0 | 0 | my ($self, $data) = @_; | 
| 45 | 0 |  | 0 |  |  | 0 | $data //= $self->{data}; | 
| 46 | 0 |  |  |  |  | 0 | return { map { $self->encode_keypair($_ => $data->{$_}) } keys %$data }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 47 |  |  |  |  |  |  | } | 
| 48 |  |  |  |  |  |  |  | 
| 49 |  |  |  |  |  |  | sub structured_data { | 
| 50 | 0 |  |  | 0 | 0 | 0 | my ($self, $data) = @_; | 
| 51 | 0 |  | 0 |  |  | 0 | $data //= $self->{data}; | 
| 52 |  |  |  |  |  |  | return { | 
| 53 |  |  |  |  |  |  | (map { | 
| 54 | 0 | 0 |  |  |  | 0 | die "invalid format for $_" unless my ($type, $k) = /^(json|text|sereal)_(.*)$/; | 
| 55 |  |  |  |  |  |  | $k => ( | 
| 56 |  |  |  |  |  |  | $type eq 'text' | 
| 57 |  |  |  |  |  |  | ? $data->{$_} | 
| 58 |  |  |  |  |  |  | : $type eq 'json' | 
| 59 |  |  |  |  |  |  | ? decode_json_utf8($data->{$_}) | 
| 60 | 0 | 0 |  |  |  | 0 | : $sereal_decode->decode($data->{$_}) | 
|  |  | 0 |  |  |  |  |  | 
| 61 |  |  |  |  |  |  | ) | 
| 62 |  |  |  |  |  |  | } grep /^[a-z]/, keys %$data), | 
| 63 | 0 |  |  |  |  | 0 | map {; $_ => $data->{$_} } grep /^_/, keys %$data | 
|  | 0 |  |  |  |  | 0 |  | 
| 64 |  |  |  |  |  |  | }; | 
| 65 |  |  |  |  |  |  | } | 
| 66 |  |  |  |  |  |  |  | 
| 67 | 5069 |  |  | 5069 | 0 | 11388 | sub future { shift->{future} } | 
| 68 |  |  |  |  |  |  |  | 
| 69 |  |  |  |  |  |  | for my $method (qw(then get done fail else catch on_done on_cancel on_fail on_ready is_ready is_done is_failed failure)) { | 
| 70 | 2 |  |  | 2 |  | 19 | no strict 'refs'; | 
|  | 2 |  |  |  |  | 5 |  | 
|  | 2 |  |  |  |  | 234 |  | 
| 71 | 5067 |  |  | 5067 |  | 7281 | *$method = sub { my $self = shift; $self->future->$method(@_) } | 
|  | 5067 |  |  |  |  | 7015 |  | 
| 72 |  |  |  |  |  |  | } | 
| 73 |  |  |  |  |  |  |  | 
| 74 |  |  |  |  |  |  | sub new { | 
| 75 | 2532 |  |  | 2532 | 0 | 48693 | my ($class, %args) = @_; | 
| 76 | 2532 |  |  |  |  | 5316 | bless \%args, $class | 
| 77 |  |  |  |  |  |  | } | 
| 78 |  |  |  |  |  |  |  | 
| 79 |  |  |  |  |  |  |  | 
| 80 |  |  |  |  |  |  | 1; |