view release on metacpan or  search on metacpan

t/TestUtils.pm  view on Meta::CPAN

package
  t::TestUtils;

use strict;
use warnings;
use File::Spec ();
use File::Copy ();
use Cwd ();
use Test::Requires 'DBD::SQLite';

use parent qw/Exporter/;
our @EXPORT = qw/ $dsn schema process_wrap process_wrap_xml runner /;

my ($_schema, $_attr);
our ($dsn, $user, $password, $DEBUG) = 
    @ENV{map { "BPMTEST_${_}" } qw/DSN USER PASS KEEP/};

if($dsn && $user && !$DEBUG) {
    $_attr = { RaiseError => 1, AutoCommit => 1 };
    }
else {
    $dsn = $DEBUG ?
        'dbi:SQLite:dbname=t/var/bpmengine.db' : 'dbi:SQLite::memory:';
    $user = '';
    $password = '';
    $_attr = { sqlite_unicode => 1 };    
    }

sub _local_db {
    my $db_file = './t/var/bpmengine.db';
    if(-f $db_file) {
        unlink $db_file or warn "Could not unlink $db_file: $!";
        }
    my (undef, $path) = File::Spec->splitpath(__FILE__);
    $path = Cwd::abs_path($path);
    my $scaffold_db = File::Spec->catfile($path, 'var', 'bpmengine.test.db');
    die("Scaffold database not found") unless -f $scaffold_db;
    File::Copy::copy($scaffold_db, $db_file) or die "Copy failed: $!";
    }

sub schema {
    unless($_schema) {
        _local_db() if $DEBUG;
        eval "require BPM::Engine::Store" 
            or die "failed to require schema: $@";
        $_schema = BPM::Engine::Store->connect($dsn, $user, $password, $_attr) 
            or die "failed to connect to $dsn";
        $_schema->deploy({ add_drop_table => $_attr->{sqlite_unicode} ? 0 : 1 }) 
            unless $DEBUG;
        }
    
    return $_schema;
    }

sub process_wrap_xml {
    my ($xml, $pack, $v) = @_;

    $xml  ||= '';
    $v    ||= 2.1;
    $pack ||= '';

    $xml = q|<?xml version="1.0" encoding="UTF-8"?>
        <Package xmlns="http://www.wfmc.org/2008/XPDL2.1" Id="TestPackage">
        <PackageHeader><XPDLVersion>| . $v . q|</XPDLVersion>
        <Vendor/><Created/></PackageHeader>|
         . $pack . '<WorkflowProcesses><WorkflowProcess Id="TestProcess"><ProcessHeader/>'
         . $xml  . '</WorkflowProcess></WorkflowProcesses></Package>';
    
    return $xml;
    }

sub process_wrap {
    my (@args) = @_;
    
    my $xml = process_wrap_xml(@args);
    
    eval "require BPM::Engine" or die "failed to require engine: $@";

    my $engine = BPM::Engine->new(schema => schema());
    my $process = $engine->create_package(\$xml)->processes->first;

    return ($engine, $process);
    }

sub runner {
    my ($engine, $process, $args) = @_;

    unless(ref($process)) {
        $process = $engine->get_process_definition({ process_uid => $process })
            or die("Process $process not found");
        }
    my $i = $engine->create_process_instance($process);

    foreach(keys %{$args}) {
        $i->attribute($_ => $args->{$_});
        }

    return ($engine->runner($i), $process, $i);
    }

1;
__END__

=pod

=head1 NAME

t::TestUtils - Test utitily functions for BPM::Engine