BPM-Engine

 view release on metacpan or  search on metacpan

inc/Module/AutoInstall.pm  view on Meta::CPAN

        # make an educated guess of whether we'll need root permission.
        print "    (You may need to do that as the 'root' user.)\n"
          if eval '$>';
    }
    print "*** $class configuration finished.\n";

    chdir $cwd;

    # import to main::
    no strict 'refs';
    *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';

    return (@Existing, @Missing);
}

sub _running_under {
    my $thing = shift;
    print <<"END_MESSAGE";
*** Since we're running under ${thing}, I'll just let it take care
    of the dependency's installation later.
END_MESSAGE

inc/Module/Install.pm  view on Meta::CPAN

#####################################################################
# Common Utility Functions

sub _caller {
	my $depth = 0;
	my $call  = caller($depth);
	while ( $call eq __PACKAGE__ ) {
		$depth++;
		$call = caller($depth);
	}
	return $call;
}

# Done in evals to avoid confusing Perl::MinimumVersion
eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _read {
	local *FH;
	open( FH, '<', $_[0] ) or die "open($_[0]): $!";
	my $string = do { local $/; <FH> };

inc/Module/Install/Makefile.pm  view on Meta::CPAN

}

sub Makefile { $_[0] }

my %seen = ();

sub prompt {
	shift;

	# Infinite loop protection
	my @c = caller();
	if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) {
		die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
	}

	# In automated testing or non-interactive session, always use defaults
	if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) {
		local $ENV{PERL_MM_USE_DEFAULT} = 1;
		goto &ExtUtils::MakeMaker::prompt;
	} else {
		goto &ExtUtils::MakeMaker::prompt;

inc/Test/Exception.pm  view on Meta::CPAN

    };
    $self->export_to_level( 1, $self, $_ ) foreach @EXPORT;
}

#line 83

sub _quiet_caller (;$) { ## no critic Prototypes
    my $height = $_[0];
    $height++;

    if ( CORE::caller() eq 'DB' ) {
        # passthrough the @DB::args trick
        package DB;
        if( wantarray ) {
            if ( !@_ ) {
                return (CORE::caller($height))[0..2];
            }
            else {
                # If we got here, we are within a Test::Exception test, and
                # something is producing a stacktrace. In case this is a full
                # trace (i.e. confess() ), we have to make sure that the sub
                # args are not visible. If we do not do this, and the test in
                # question is throws_ok() with a regex, it will end up matching
                # against itself in the args to throws_ok().
                #
                # While it is possible (and maybe wise), to test if we are
                # indeed running under throws_ok (by crawling the stack right
                # up from here), the old behavior of Test::Exception was to
                # simply obliterate @DB::args altogether in _quiet_caller, so
                # we are just preserving the behavior to avoid surprises
                #
                my @frame_info = CORE::caller($height);
                @DB::args = ();
                return @frame_info;
            }
        }

        # fallback if nothing above returns
        return CORE::caller($height);
    }
    else {
        if( wantarray and !@_ ) {
            return (CORE::caller($height))[0..2];
        }
        else {
            return CORE::caller($height);
        }
    }
}

sub _try_as_caller {
    my $coderef = shift;

    # local works here because Sub::Uplevel has already overridden caller
    local *CORE::GLOBAL::caller;
    { no warnings 'redefine'; *CORE::GLOBAL::caller = \&_quiet_caller; }

inc/Test/Exception.pm  view on Meta::CPAN

sub throws_ok (&$;$) {
    my ( $coderef, $expecting, $description ) = @_;
    unless (defined $expecting) {
      require Carp;
      Carp::croak( "throws_ok: must pass exception class/object or regex" ); 
    }
    $description = _exception_as_string( "threw", $expecting )
    	unless defined $description;
    my $exception = _try_as_caller( $coderef );
    my $regex = $Tester->maybe_regex( $expecting );
    my $ok = $regex 
        ? ( $exception =~ m/$regex/ ) 
        : eval { 
            $exception->isa( ref $expecting ? ref $expecting : $expecting ) 
        };
    $Tester->ok( $ok, $description );
    unless ( $ok ) {
        $Tester->diag( _exception_as_string( "expecting:", $expecting ) );
        $Tester->diag( _exception_as_string( "found:", $exception ) );
    };
    $@ = $exception;
    return $ok;
};


#line 254

sub dies_ok (&;$) {
    my ( $coderef, $description ) = @_;
    my $exception = _try_as_caller( $coderef );
    my $ok = $Tester->ok( _is_exception($exception), $description );
    $@ = $exception;
    return $ok;
}


#line 293

sub lives_ok (&;$) {
    my ( $coderef, $description ) = @_;
    my $exception = _try_as_caller( $coderef );
    my $ok = $Tester->ok( ! _is_exception( $exception ), $description );
	$Tester->diag( _exception_as_string( "died:", $exception ) ) unless $ok;
    $@ = $exception;
    return $ok;
}


#line 333

sub lives_and (&;$) {

inc/Test/More.pm  view on Meta::CPAN

#---- perlcritic exemptions. ----#

# We use a lot of subroutine prototypes
## no critic (Subroutines::ProhibitSubroutinePrototypes)

# Can't use Carp because it might cause use_ok() to accidentally succeed
# even though the module being used forgot to use Carp.  Yes, this
# actually happened.
sub _carp {
    my( $file, $line ) = ( caller(1) )[ 1, 2 ];
    return warn @_, " at $file line $line\n";
}

our $VERSION = '0.98';
$VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)

use Test::Builder::Module;
our @ISA    = qw(Test::Builder::Module);
our @EXPORT = qw(ok use_ok require_ok
  is isnt like unlike is_deeply

inc/Test/Requires.pm  view on Meta::CPAN

#line 1
package Test::Requires;
use strict;
use warnings;
our $VERSION = '0.06';
use base 'Test::Builder::Module';
use 5.006000;

sub import {
    my $class = shift;
    my $caller = caller(0);

    # export methods
    {
        no strict 'refs';
        *{"$caller\::test_requires"} = \&test_requires;
    }

    # test arguments
    if (@_ == 1 && ref $_[0] && ref $_[0] eq 'HASH') {
        while (my ($mod, $ver) = each %{$_[0]}) {

inc/Test/Requires.pm  view on Meta::CPAN

        for my $mod (@_) {
            test_requires($mod, undef, $caller);
        }
    }
}

sub test_requires {
    my ( $mod, $ver, $caller ) = @_;
    return if $mod eq __PACKAGE__;
    if (@_ != 3) {
        $caller = caller(0);
    }
    $ver ||= '';

    eval qq{package $caller; use $mod $ver}; ## no critic.
    if (my $e = $@) {
        my $skip_all = sub {
            my $builder = __PACKAGE__->builder;

            if (not defined $builder->has_plan) {
                $builder->skip_all(@_);

lib/BPM/Engine/Store/ResultSet/Package.pm  view on Meta::CPAN

use Moose;
use MooseX::NonMoose;
use Scalar::Util qw/blessed/;
use BPM::Engine::Util::XPDL ':all';
use BPM::Engine::Exceptions qw/throw_model throw_store/;
extends 'DBIx::Class::ResultSet';

my %APPMAP = ();

sub debug {
    #my @caller = caller(0); warn $_[0] . ' at line ' . $caller[2] . "\n";
    }

sub create_from_xml {
    my ($self, $arg) = @_;

    $arg = xml_hash($arg) unless(ref($arg) eq 'HASH');
    
    return $self->_create_from_hash($arg);
    }