view release on metacpan or  search on metacpan

t/fullblown.t  view on Meta::CPAN

        id =>
            { data_type => "integer", is_auto_increment => 1, is_nullable => 0 },
        name =>
            { data_type => 'varchar', is_nullable => 0, size => 50 },
        looks_cancerous =>
            { data_type => 'integer', is_nullable => 0 , default_value => 0 },
        family_history =>
            { data_type => 'integer', is_nullable => 0 , default_value => 0 },
    );
    __PACKAGE__->set_primary_key("id");
    1;
}

{
    package MyApp::Schema::Result::Process;
    use base qw/DBIx::Class::Core/;
    __PACKAGE__->table('longprocess');
    __PACKAGE__->load_components(qw/InflateColumn::DateTime InflateColumn::Serializer/);
    __PACKAGE__->add_columns(
        id =>
            { data_type => "integer", is_auto_increment => 1, is_nullable => 0 },
        process_class =>
            { data_type => "varchar", is_nullable => 0, size => 255 },
        what =>
            { data_type => "varchar", is_nullable => 1, size => 255 },
        status =>
            { data_type => "varchar", is_nullable => 0, size => 50 , default_value => 'pending' },
        run_at =>
            { data_type => "datetime", datetime_undef_if_invalid => 1, is_nullable => 1 },
        run_id =>
            { data_type => "varchar", is_nullable => 1, size => 36 },
        state =>
            { data_type => "text",
              serializer_class => 'JSON',
              is_nullable => 0,
          },
        error =>
            { data_type => "text", is_nullable => 1 }
        );

    __PACKAGE__->set_primary_key("id");
    sub sqlt_deploy_hook {
        my ($self, $sqlt_table) = @_;
        $sqlt_table->add_index(name => 'idx_longprocess_run_id', fields => ['run_id']);
        $sqlt_table->add_index(name => 'idx_longprocess_run_at', fields => ['run_at']);
    }
    1;
}

{
    package MyApp::Schema;
    use base qw/DBIx::Class::Schema/;
    __PACKAGE__->load_classes({ 'MyApp::Schema::Result' => [ 'Process', 'Patient' ] });

    sub connection{
        my ($class, @args ) = @_;
        unless( ( ref $args[0] || '' ) eq 'CODE' ){
            defined( $args[3] ) or ( $args[3] = {} );
            $args[3]->{AutoCommit} = 1;
            $args[3]->{RaiseError} = 1;
            $args[3]->{mysql_enable_utf8} = 1;
            ## Only for mysql DSNs
            $args[3]->{on_connect_do} = ["SET SESSION sql_mode = 'TRADITIONAL'"];
        }
        my $self = $class->next::method(@args);
        return $self;
    }
    1;
}

#
# Then we build our test Process.
#
{
    package MyMedicalProcess;
    # Inspired by https://en.wikipedia.org/wiki/XPDL Medical process example
    use Moose;
    extends qw/Schedule::LongSteps::Process/;

    use DateTime;

    has 'schema' => ( is => 'ro', isa => 'DBIx::Class::Schema', required => 1);

    has 'patient' => ( is => 'ro', lazy_build => 1 );
    sub _build_patient{
        my ($self) = @_;
        return $self->schema()->resultset('Patient')->find($self->state()->{patient_id});
    }

    sub build_first_step{
        my ($self) = @_;
        return $self->new_step({ what => 'do_first_look', run_at => DateTime->now() });
    }

    sub do_first_look{
        my ($self) = @_;
        my $state = $self->state();
        my $patient = $self->patient();
        if( ! $patient->looks_cancerous() ){
            return $self->final_step({ state => { %$state , has_cancer => 0 } });
        }
        return $self->new_step({ what => 'do_analyze_more', run_at => DateTime->now() });
    }

    sub do_analyze_more{
        my ($self) = @_;
        my $state = $self->state();
        my $p1 = $self->longsteps->instantiate_process('AnalyzePatient', { schema =>  $self->schema()  }, { %$state });
        my $p2 = $self->longsteps->instantiate_process('AnalyzeFamily', { schema => $self->schema() } , { %$state });
        return $self->new_step({ what => 'do_synthetize_analyzes', run_at => DateTime->now()->add( days => 3 ),
                                 state => { %$state , processes => [ $p1->id(), $p2->id() ] } });
    }
    sub do_synthetize_analyzes{
        my ($self) = @_;
        return $self->wait_processes(
            $self->state()->{processes},
            sub{
                my ( @processes ) = @_;
                return $self->new_step({
                    what => 'do_prescribe',
                    run_at => DateTime->now(),