File Coverage

lib/Redis/JobQueue/Job.pm

Criterion	Covered	Total	%
statement	100	105	95.2
branch	29	34	85.2
condition	6	9	66.6
subroutine	23	24	95.8
pod	5	5	100.0
total	163	177	92.0

package Redis::JobQueue::Job;

=head1 NAME

Redis::JobQueue::Job - Object interface for creating and manipulating jobs

=head1 VERSION

This documentation refers to C version 1.17

=cut

#-- Pragmas --------------------------------------------------------------------

use 5.010;
use strict;
use warnings;

# ENVIRONMENT ------------------------------------------------------------------

our $VERSION = '1.17';

#-- load the modules -----------------------------------------------------------

use Exporter qw(
    import
);
our @EXPORT_OK  = qw(
    STATUS_CREATED
    STATUS_WORKING
    STATUS_COMPLETED
    STATUS_FAILED
);

#-- load the modules -----------------------------------------------------------

# Modules
use Carp;
use List::Util qw(
    min
);
use Mouse;                                      # automatically turns on strict and warnings
use Mouse::Util::TypeConstraints;
use Params::Util qw(
    _HASH0
    _INSTANCE
);
use Time::HiRes qw();

#-- declarations ---------------------------------------------------------------

=head1 SYNOPSIS

There are several ways to create a C
object:

    my $pre_job = {
        id           => '4BE19672-C503-11E1-BF34-28791473A258',
        queue        => 'lovely_queue',
        job          => 'strong_job',
        expire       => 12*60*60,               # 12h
        status       => STATUS_CREATED,
        workload     => \'Some stuff up to 512MB long',
        result       => \'JOB result comes here, up to 512MB long',
    };

    my $job = Redis::JobQueue::Job->new(
        id           => $pre_job->{id},
        queue        => $pre_job->{queue},
        job          => $pre_job->{job},
        expire       => $pre_job->{expire},
        status       => $pre_job->{status},
        workload     => $pre_job->{workload},
        result       => $pre_job->{result},
    );

    $job = Redis::JobQueue::Job->new( $pre_job );

    my $next_job = Redis::JobQueue::Job->new( $job );

Access methods to read and assign the relevant attributes of the object.
For example:

    $job->$workload( \'New workload' );
    # or
    $job->$workload( 'New workload' );

    my $id = $job->id;
    # 'workload' and 'result' return a reference to the data
    my $result = ${ $job->result };

Returns a list of names of the modified object fields:

    my @modified = $job->modified_attributes;

Resets the sign of changing an attribute. For example:

    $job->clear_modified( qw( status ) );

=head1 DESCRIPTION

Job API is implemented by C class.

The main features of the C class are:

=over 3

=item *

Provides an object oriented model of communication.

=item *

Supports data representing various aspects of the job.

=item *

Supports the creation of the job object, an automatic allowance for the change
attributes and the ability to cleanse the signs of change attributes.

=back

=head1 EXPORT

None by default.

The following additional constants, defining defaults for various parameters, are available for export:

=over

=item C

Initial status of the job, showing that it was created.

=cut
use constant STATUS_CREATED     => '__created__';

=item C

Jobs is being executed. Set by the worker function.

=cut
use constant STATUS_WORKING     => '__working__';

=item C

Job is completed. Set by the worker function.

=cut
use constant STATUS_COMPLETED   => '__completed__';

=item C

Job has failed. Set by the worker function.

=cut
use constant STATUS_FAILED      => '__failed__';

=back

User himself should specify the status L, L, L
or own status when processing the job.

=cut

my $meta = __PACKAGE__->meta;

subtype __PACKAGE__.'::NonNegInt',
    as 'Int',
    where { $_ >= 0 },
    message { ( $_ || '' ).' is not a non-negative integer!' },
;

subtype __PACKAGE__.'::NonNegNum',
    as 'Num',
    where { $_ >= 0 },
    message { ( $_ || '' ).' is not a non-negative number!' },
;

subtype __PACKAGE__.'::Progress',
    as 'Num',
    where { $_ >= 0 and $_ <= 1 },
    message { ( $_ || '' ).' is not a progress number!' },
;

subtype __PACKAGE__.'::WOSpStr',
    as 'Str',
    where { $_ !~ / / },
    message { ( $_ || '' ).' contains spaces!' },
;

subtype __PACKAGE__.'::DataRef',
    as 'ScalarRef'
;

coerce __PACKAGE__.'::DataRef',
    from 'Str',
    via { \$_ },
;

#-- constructor ----------------------------------------------------------------

=head2 CONSTRUCTOR

An error will cause the program to halt if the argument is not valid.

=head3 C $uuid, ... )>

It generates a Job object and can be called as either a class method or
an object method.

If invoked with the first argument being an object of C class
or a reference to a hash, then the new object attribute values are taken from
the hash of the first argument.

C optionally takes arguments. These arguments are in key-value pairs.

This example illustrates a C call with all the valid arguments:

    $job = Redis::JobQueue::Job->new(
        id          => '4BE19672-C503-11E1-BF34-28791473A258',
                # UUID string, using conventional UUID string format.
                # Do not use it because filled in automatically when
                # you create a job.
        queue       => 'lovely_queue',  # The name of the job queue.
                                        # (required)
        job         => 'strong_job',    # The name of the job.
                                        # (optional attribute)
        expire      => 12*60*60,        # Job's time to live in seconds.
                                        # 0 for no expire time.
                                        # (required)
        status      => STATUS_CREATED,  # Current status of the job.
                # Do not use it because value should be set by the worker.
        workload    => \'Some stuff up to 512MB long',
                # Baseline data for the function of the worker
                # (the function name specified in the 'job').
                # Can be a scalar, an object or a reference to a scalar, hash, or array
        result      => \'JOB result comes here, up to 512MB long',
                # The result of the function of the worker
                # (the function name specified in the 'job').
                # Do not use it because value should be set by the worker.
    );

Returns the object itself, we can chain settings.

The attributes C and C may contain a large amount of data,
therefore, it is desirable that they be passed as references to the actual
data to improve performance.

Do not use spaces in an C attribute value.

Each element in the struct data has an accessor method, which is
used to assign and fetch the element's value.

=cut
around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;

    if ( _INSTANCE( $_[0], __PACKAGE__ ) ) {
        my $job = shift;
        return $class->$orig( ( map { ( $_, $job->$_ ) } $job->job_attributes ), @_ );
    } else {
        return $class->$orig( @_ );
    }
};

#-- public attributes ----------------------------------------------------------

=head2 METHODS

An error will cause the program to halt if the argument is not valid.

=head3 C

=head3 C

=head3 C

=head3 C

=head3 C

=head3 C

=head3 C

The family of methods for a multitude of accessor methods for your data with
the appropriate names. These methods are able to read and assign the relevant
attributes of the object.

As attributes C and C may contain a large amount of data
(scalars, references to arrays and hashes, objects):

=over 3

=item *

A read method returns a reference to the data.

=item *

A write method can receive both data or a reference to the data.

=back

=cut
has 'id'            => (
    is          => 'rw',
    isa         => __PACKAGE__.'::WOSpStr',
    default     => '',
    trigger     => sub { $_[0]->_modified_set( 'id' ) },
);

has 'queue'         => (
    is          => 'rw',
    isa         => 'Maybe[Str]',
    required    => 1,
    trigger     => sub { $_[0]->_modified_set( 'queue' ) },
);

has 'job'           => (
    is          => 'rw',
    isa         => 'Maybe[Str]',
    default     => '',
    trigger     => sub { $_[0]->_modified_set( 'job' ) },
);

has 'status'        => (
    is          => 'rw',
    isa         => 'Str',
    default     => STATUS_CREATED,
    trigger     => sub { $_[0]->_modified_set( 'status', $_[1] ) },
);

has 'expire'        => (
    is          => 'rw',
    isa         => 'Maybe['.__PACKAGE__.'::NonNegInt]',
    required    => 1,
    trigger     => sub { $_[0]->_modified_set( 'expire' ) },
);

for my $name ( qw( workload result ) ) {
    has $name           => (
        is          => 'rw',
        # A reference because attribute can contain a large amount of data
        isa         => __PACKAGE__.'::DataRef | HashRef | ArrayRef | ScalarRef | Object',
        coerce      => 1,
        builder     => '_build_data',           # will throw an error if you pass a bare non-subroutine reference as the default
        trigger     => sub { $_[0]->_modified_set( $name ) },
    );
}

=head3 C

Optional attribute, the progress of the task,
contains a user-defined value from 0 to 1.

=cut
has 'progress'      => (
    is          => 'rw',
    isa         => __PACKAGE__.'::Progress',
    default     => 0,
    trigger     => sub { $_[0]->_modified_set( 'progress' ) },
);

=head3 C

Optional attribute, a string message with additional user-defined information.

=cut
has 'message'       => (
    is          => 'rw',
    isa         => 'Maybe[Str]',
    default     => '',
    trigger     => sub { $_[0]->_modified_set( 'message' ) },
);

=head3 C

Returns time of job creation.
Set to the current time (C) when job is created.

If necessary, alternative value can be set as:

    $job->created( time );

=head3 C

Returns the time of the most recent modification of the job.

Set to the current time (C) when value(s) of any of the following data changes:
L, L, L, L, L, L, L.

Can be updated manually:

    $job->updated( time );

=cut
for my $name ( qw( created updated ) ) {
    has $name           => (
        is          => 'rw',
        isa         => __PACKAGE__.'::NonNegNum',
        default     => sub { Time::HiRes::time },
        trigger     => sub { $_[0]->_modified_set( $name ) },
    );
}

=head3 C

Returns the time that the job started processing.
Set to the current time (C) when the L of the job is set to L.

If necessary, you can set your own value, for example:

    $job->started( time );

=head3 C

Returns the time of the task completion.

It is set to 0 when task is created.

Set to C when L is changed to L.

Can be modified manually:

    $job->completed( time );

Change the C attribute sets C = 0.
The attributes C and C are mutually exclusive.

=head3 C

Returns the time of the task failure.

It is set to 0 when task is created.

Set to C when L is changed to L.

Can be modified manually:

    $job->failed( time );

Change the C attribute sets C = 0.
The attributes C and C are mutually exclusive.

=cut
for my $name ( qw( started completed failed ) ) {
    has $name           => (
        is          => 'rw',
        isa         => __PACKAGE__.'::NonNegNum',
        default     => 0,
        trigger     => sub { $_[0]->_modified_set( $name ) },
    );
}

#-- private attributes ---------------------------------------------------------

has '_meta_data'    => (
    is          => 'rw',
    isa         => 'HashRef',
    init_arg    => 'meta_data',
    default     => sub { {} },
);

has '__modified'    => (
    is          => 'ro',
    isa         => 'HashRef[Int]',
    lazy        => 1,
    init_arg    => undef,                       # we make it impossible to set this attribute when creating a new object
    builder     => '_build_modified',
);

has '__modified_meta_data'  => (
    is          => 'rw',
    isa         => 'HashRef[Int]',
    lazy        => 1,
    init_arg    => undef,                       # we make it impossible to set this attribute when creating a new object
    default     => sub { return {}; },
);

#-- public methods -------------------------------------------------------------

=head3 C

Returns the time (a floating seconds since the epoch) since the job started processing (see L)
till job L or L or to the current time.
Returns C if the start processing time was set to 0.

=cut
sub elapsed {
    my ( $self ) = @_;

    if ( my $started = $self->started ) {
        return( ( $self->completed || $self->failed || Time::HiRes::time ) - $started );
    } else {
        return( undef );
    }
}

=head3 C

With no arguments, returns a reference to a hash of metadata (additional information related to the job).
For example:

    my $md = $job->meta_data;

Hash value of an individual item metadata is available by specifying the name of the hash key.
For example:

    my $foo = $job->meta_data( 'foo' );

Separate metadata value can be set as follows:

    my $foo = $job->meta_data( next => 16 );

Group metadata can be specified by reference to a hash.
Metadata may contain scalars, references to arrays and hashes, objects.
For example:

    $job->meta_data(
        {
            'foo'   => 12,
            'bar'   => [ 13, 14, 15 ],
            'other' => { a => 'b', c => 'd' },
        }
    );

The name of the metadata fields should not match the standard names returned by
L and must not begin with C<'__'}>.
An invalid name causes die (C).

=cut
my %_attributes = map { ( $_->name eq '_meta_data' ? 'meta_data' : $_->name ) => 1 } grep { substr( $_->name, 0, 2 ) ne '__' } $meta->get_all_attributes;

sub meta_data {
    my ( $self, $key, $val ) = @_;

    return $self->_meta_data
        if !defined $key;

    # metadata can be set with an external hash
    if ( _HASH0( $key ) ) {
        foreach my $field ( keys %$key ) {
            confess 'The name of the metadata field the same as standart job field name'
                if exists $_attributes{ $field } || substr( $field, 0, 2 ) eq '__';
        }
        $self->_meta_data( $key );
        $self->__modified_meta_data( {} );
        $self->__modified_meta_data->{ $_ } = 1
            foreach keys %$key;
        return;
    }

    # getter
    return $self->_meta_data->{ $key }
        if !defined $val;

    # setter
    confess 'The name of the metadata field the same as standart job field name'
        if exists $_attributes{ $key } || substr( $key, 0, 2 ) eq '__';
    $self->_meta_data->{ $key } = $val;
    ++$self->__modified_meta_data->{ $key };

    # job data change
    $self->updated( Time::HiRes::time );
    ++$self->__modified->{ 'updated' };

    return;
}

=head3 C

Resets the sign of any specified attributes that have been changed.
If no attribute names are specified, the signs are reset for all attributes.

=cut
sub clear_modified {
    my ( $self, @fields ) = @_;

    unless ( @fields ) {
        $self->clear_modified( $self->job_attributes );
        my @keys = keys %{ $self->__modified_meta_data };
        $self->clear_modified( @keys )
            if @keys;
        return;
    }

    foreach my $field ( @fields ) {
        if    ( exists $self->__modified->{ $field } ) { $self->__modified->{ $field } = 0 }
        elsif ( exists $self->__modified_meta_data->{ $field } ) { $self->__modified_meta_data->{ $field } = 0 }
    }
}

=head3 C

Returns a list of names of the object attributes that have been modified.

=cut
sub modified_attributes {
    my ( $self ) = @_;

    my @all_modified = (
        grep( { $self->__modified->{ $_ } } $self->job_attributes ),
        grep( { $self->__modified_meta_data->{ $_ } } keys( %{ $self->__modified_meta_data } ) ),
    );

    return @all_modified;
}

=head3 C

Returns a sorted list of the names of object attributes.

=cut
sub job_attributes {
    return( sort keys %_attributes );
}

#-- private methods ------------------------------------------------------------

sub _build_data {
    my $empty_data = q{};
    return \$empty_data;
}

sub _build_modified {
    my ( $self ) = @_;

    my %modified;
    map { $modified{ $_ } = 1 } $self->job_attributes;
    return \%modified;
}

sub _modified_set {
    my $self    = shift;
    my $field   = shift;

    if ( $field =~ /^(status|meta_data|workload|result|progress|message|started|completed|failed)$/ ) {
        $self->updated( Time::HiRes::time );
        ++$self->__modified->{ 'updated' };
    }

    if ( $field eq 'status' ) {
        my $new_status = shift;
        if      ( $new_status eq STATUS_CREATED )   { $self->created( Time::HiRes::time ) }
        elsif   ( $new_status eq STATUS_WORKING )   { $self->started( Time::HiRes::time ) unless $self->started }
        elsif   ( $new_status eq STATUS_COMPLETED ) { $self->completed( Time::HiRes::time ) }
        elsif   ( $new_status eq STATUS_FAILED )    { $self->failed( Time::HiRes::time ) }
    }

    ++$self->__modified->{ $field };
}

#-- Closes and cleans up -------------------------------------------------------

no Mouse::Util::TypeConstraints;
no Mouse;                                       # keywords are removed from the package
__PACKAGE__->meta->make_immutable();

__END__