Activator
view release on metacpan or search on metacpan
bin/activator.pl view on Meta::CPAN
$httpd_pid = `$cmd`;
chomp $httpd_pid;
}
# convenience vars
my $project_codebase = $config->{project_codebase};
my $perl5lib = $config->{apache2}->{PERL5LIB};
my $document_root = $config->{apache2}->{DocumentRoot};
my $server_root = $config->{apache2}->{ServerRoot};
my $rsync_flags = ( $config->{debug} ? '-v' : '' );
$rsync_flags .= ' --cvs-exclude';
# these commands need to run to create the target installation
my @cmds = (
# blow away the target dir
"rm -rf $config->{sync_target}",
"mkdir -p $config->{sync_target}",
"mkdir -p $config->{sync_run_dir}",
"mkdir -p $config->{sync_lock_dir}",
bin/activator.pl view on Meta::CPAN
ABSOLUTE => 1,
OUTPUT_PATH => $config->{sync_conf_dir},
}
);
DEBUG( qq(tt processing: $fq_source_file, $config, $out ));
$tt->process( $fq_source_file, $config, $out ) || Activator::Log->logdie( $tt->error()."\n");
}
# just copy the file
else {
my $rsync_flags = ( $config->{debug} ? '-v' : '' );
$rsync_flags .= ' --cvs-exclude';
my $cmd = "rsync -a $rsync_flags $fq_source_file $fq_dest_file";
die "$cmd failed" unless !system( $cmd );
}
}
&restart();
}
sub restart {
lib/Activator/Config.pm view on Meta::CPAN
WARN( "Skipped invalid environment variable $env_key. Key '$opt_key' for realm '$opt_realm' unchanged");
}
}
}
# forced overrides from config files
my $overrides = $self->{REGISTRY}->get_realm( 'overrides' );
DEBUG( Data::Dumper->Dump( [ $overrides ], [ 'processing overrides' ] ) );
# NOTE: bad (typo) keys could be in overrides. Someday,
# Activator::Registry will allow debug mode so we can
# show this.
if ( exists( $overrides->{ $realm } ) ) {
$self->{REGISTRY}->register_hash( 'right', $overrides->{ $realm }, $realm );
}
# now that realm is set, make sure our $config points to it
$config = $self->{REGISTRY}->get_realm( $realm );
# Override any provided command line options into this realm.
# Strips known options out of \@ARGV
lib/Activator/Config.pm view on Meta::CPAN
Throws C<Activator::Exception::Config> when arg is invalid (which at this
time is only when a barewod arg of '=' is detected).
=cut
sub get_args {
my ( $pkg, $argv_raw ) = @_;
my $self = &new( @_ );
# quick and dirty check for debug mode
if( grep /^--?debug$/, @$argv_raw ) {
Activator::Log->level('DEBUG');
DEBUG('Entering debug mode');
}
if ( defined( $self->{ARGV} ) || defined( $self->{BAREWORDS} ) ) {
DEBUG("skipping ARGV reprocessing");
return ( $self->{ARGV}, $self->{BAREWORDS} );
}
DEBUG("got ARGV: ". join(' ', @$argv_raw ));
# use refs to insure that that $self->{ARGV} and
lib/Activator/Config.pm view on Meta::CPAN
}
# save these so we don't have to do it again
$self->{ARGV} = $argv;
$self->{BAREWORDS} = $barewords;
return ( $argv, $barewords );
}
# Helper to split an arg into key/value. Returns ($key, $value), where
# $value is undef if the argument is flag format (--debug), undef if
# it is a bareword ( foo ) and '--' if it is the arguments terminator
# symbol.
#
sub _get_arg {
my ( $self, $arg ) = @_;
if ( $arg !~ /^-(-)?/ ) {
return;
}
lib/Activator/DB.pm view on Meta::CPAN
};
if ( catch my $e ) {
$self->{cur_alias} = $self->{last_alias};
$e->rethrow;
}
# est. the actual connection if it's not set
if ( !$conn->{dbh} ) {
try eval {
$self->_debug_connection( 2, "Connecting to alias $self->{cur_alias}" );
$self->_debug_connection( 2, 'Connect Parameters:');
$self->_debug_connection( 2, " dsn => $conn->{dsn}");
$self->_debug_connection( 2, " user => $conn->{user}");
$self->_debug_connection( 2, ' pass => ' . ( $conn->{pass} || ''));
$self->_debug_connection( 2, Data::Dumper->Dump( [ $conn->{attr} ], [ ' attr' ] ) );
try eval {
$conn->{dbh} = DBI->connect( $conn->{dsn},
$conn->{user} || '',
$conn->{pass} || '',
$conn->{attr}
);
};
if ( catch my $e ) {
lib/Activator/DB.pm view on Meta::CPAN
# TODO: do something more generic with this
# mysql_auto_reconnect now cannot be disconnected
if ( $conn->{dsn} =~ /mysql/i ) {
$conn->{dbh}->{mysql_auto_reconnect} = $self->{config}->{mysql}->{auto_reconnect};
}
elsif ( my $search_path = $conn->{config}->{Pg}->{search_path} ) {
$self->do("SET search_path TO ?", [ $search_path ]);
}
# test cur_alias $conn->{dbh}, may throw exception
$self->_ping();
$self->_debug_connection( 2, "alias '$conn->{alias}' db handle pinged and ready for action");
};
if ( catch my $e ) {
$e->rethrow;
}
}
return $self;
}
lib/Activator/DB.pm view on Meta::CPAN
$self->_start_timer();
my $setup = Activator::Registry->get( 'Activator::DB' );
if (!keys %$setup ) {
$setup = Activator::Registry->get( 'Activator->DB' );
if (!keys %$setup ) {
Activator::Exception::DB->throw( 'activator_db_config', 'missing', 'You must define the key "Activator::DB" or "Activator->DB" in your project configuration' );
}
}
# module defaults
$self->{config} = { debug => 0,
debug_connection => 0,
debug_attr => 0,
reconn_att => 3,
reconn_sleep => 1,
mysql => { auto_reconnect => 1 },
Pg => { search_path => 'public' },
};
$self->{attr} = { RaiseError => 0,
PrintError => 0,
HandleError => Exception::Class::DBI->handler,
AutoCommit => 1,
};
lib/Activator/DB.pm view on Meta::CPAN
# setup default config
foreach my $key( keys %{ $setup->{default}->{config} } ) {
if ( exists ( $self->{config}->{ $key } ) ) {
$self->{config}->{ $key } = $setup->{default}->{config}->{ $key };
}
else {
WARN( "Ignoring default->config->$key: unsupported config option" );
}
}
# Activator::Log::set_level( $self->{config}->{debug}
# ? $Activator::Log::$self->_debug
# : $Activator::Log::WARN );
# setup connection strings
my ( $host, $db, $user, $pass );
my $conns = $setup->{connections};
foreach my $alias ( keys( %$conns ) ) {
my $engine;
$engine = 'mysql' if $conns->{ $alias }->{dsn} =~ /mysql/;
$engine = 'Pg' if $conns->{ $alias }->{dsn} =~ /Pg/;
lib/Activator/DB.pm view on Meta::CPAN
# setup default config
foreach my $key ( keys %{ $conns->{ $alias }->{config} } ) {
if ( exists ( $self->{config}->{ $key } ) ) {
$self->{connections}->{ $alias }->{config}->{ $key } =
$conns->{ $alias }->{config}->{ $key };
} else {
WARN( "Ignoring ${alias}->config->${key}: unsupported config option" );
}
}
$self->_debug_connection( 2, "Initialized connection ".
Data::Dumper->Dump( [ $self->{connections}->{$alias} ],
[ $alias ] ) );
}
$self->_debug_connection( 2, 'Activator::DB initialization successful');
}
# _ping>($conn)
#
# Test a database handle and attempt to reconnect if it is done
#
# Args:
# $conn_alias => connection alias to check
#
# Throws:
lib/Activator/DB.pm view on Meta::CPAN
# _get_cur_conn
#
# return the internal connection hash for the current connection alias
sub _get_cur_conn {
my ( $self ) = @_;
if ( exists( $self->{connections}->{ $self->{cur_alias} } ) ) {
my $conn = $self->{connections}->{ $self->{cur_alias} };
# # set the log level to this connection
# LEVEL( $conn->{config}->{debug}
# ? $Log::Log4perl::$self->_debug
# : $Log::Log4perl::WARN );
return $conn;
}
Activator::Exception::DB->throw('alias', 'invalid', $self->{cur_alias} )
}
# explode args for a db query sub
sub _explode {
my ( $pkg, $bindref, $args ) = @_;
lib/Activator/DB.pm view on Meta::CPAN
my $attr = $args->{attr} || {};
return ( $self, $bind, $attr );
}
# This can never die, so we jump through hoops to return some valid scalar.
# * replace undef values with NULL, since this is how dbi will do it
# * If $bind is of wrong type, don't do substitutions.
# * shift @vals to handle the case of '?' in the bind values
# * @vals? in the regexp is to handle fewer args on the right than the left
# TODO: support attrs in debug
sub _get_sql {
my ( $pkg, $sql, $bind ) = @_;
$sql ||= '';
$bind ||= [];
if ( ref( $bind ) eq 'ARRAY' ) {
my @vals = @$bind;
map {
if ( !defined($_) ) {
$_ = 'NULL';
lib/Activator/DB.pm view on Meta::CPAN
# clean up return value for total consistency.
if ( !defined( $row ) ) {
if ( $fn eq 'getrow_hashref' ) {
$row = {};
}
else {
$row = [];
}
}
$self->_debug_sql( 5, $sql, $bind, \%args);
if ( $fn eq 'getrow' ) {
return ( $self, $sql, $bind, \%args, @row );
}
return ( $self, $sql, $bind, \%args, $row );
}
sub do_id {
my ( $pkg, $sql, $bindref, %args ) = @_;
lib/Activator/DB.pm view on Meta::CPAN
$self->_start_timer();
my $res;
try eval {
$res = $self->_get_sth( $sql, $bind, $attr, 'want_exec_result' );
};
if ( catch my $e ) {
$e->rethrow;
}
$self->_debug_sql( 4, $sql, $bind, \%args );
if ( $res == 1 ) {
if ( $conn->{engine} eq 'mysql' ) {
return $conn->{dbh}->{mysql_insertid};
}
elsif ( $conn->{engine} eq 'Pg' ) {
my $row = $self->getrow_arrayref( "SELECT currval('$args{seq}')" );
return @$row[0];
}
} else {
lib/Activator/DB.pm view on Meta::CPAN
$self->_start_timer();
my $res;
try eval {
$res = $conn->{dbh}->do( $sql, $attr, @$bind );
};
if ( catch my $e ) {
$e->rethrow;
}
$self->_debug_sql( 4, $sql, $bind, \%args );
if ( $res eq '0E0' ) {
return 0;
}
return $res;
}
# allow diconnection before DESTROY is called
sub disconnect_all {
my ( $pkg ) = @_;
lib/Activator/DB.pm view on Meta::CPAN
}
}
sub as_string {
my ( $pkg, $sql, $bind ) = @_;
return Activator::DB->_get_sql( $sql, $bind );
}
sub _start_timer {
my ( $self ) = @_;
$self->{debug_timer} = [gettimeofday];
}
sub _debug_sql {
my ( $self, $depth, $sql, $bind, $args ) = @_;
if ( $sql =~ /foo/ ) {
warn Dumper( $args );
}
my $conn = $self->_get_cur_conn();
if ( $args->{debug} ||
$self->{config}->{debug} ||
$conn->{config}->{debug} ) {
local $Log::Log4perl::caller_depth;
$Log::Log4perl::caller_depth += $depth;
my $str = $self->_get_sql( $sql, $bind );
DEBUG( tv_interval( $self->{debug_timer}, [ gettimeofday ] ). " $str".
( $self->{config}->{debug_attr} ? "\n\t" .
Data::Dumper->Dump( [ $conn->{attr} ], [ 'attr' ] ) : '' )
);
}
}
sub _debug_connection {
my ( $self, $depth, $msg, $args ) = @_;
if ( $self->{config}->{debug_connection} ) {
local $Log::Log4perl::caller_depth;
$Log::Log4perl::caller_depth += $depth;
DEBUG( $msg );
}
}
sub _debug {
my ( $self, $depth, $msg ) = @_;
if ( $self->{config}->{debug} ) {
local $Log::Log4perl::caller_depth;
$Log::Log4perl::caller_depth += $depth;
DEBUG( $msg );
}
}
sub begin_debug {
my ( $self ) = @_;
$self->{config}->{debug} = 1;
}
sub end_debug {
my ( $self ) = @_;
$self->{config}->{debug} = 0;
}
=head1 NAME
Activator::DB - Wrap DBI with convenience subroutines and consistant
access accross all programs in a project.
=head1 Synopsis
use Activator::DB;
lib/Activator/DB.pm view on Meta::CPAN
Provide consistent arguments handling to all query functions.
=item *
Provides connection caching without Apache::DBI -- this allows use of
your model layer code in crons, daemons AND website.
=item *
Connection and query debug dumps using your project or module level
C<Activator::Log> config, or on a per-query basis.
=item *
Allows all code in your project/team/company to access the db in a
consistent fashion.
=item *
By default, dies on all errors enforcing try/catch programming
lib/Activator/DB.pm view on Meta::CPAN
'Activator::Registry':
log4perl<.conf>: # Log4perl config file or definition
# See Logging Configuration below
'Activator::DB':
default: # default configuration for all connections
connection: <conn_alias>
## Optional default attributes and config for all connections
config:
debug: 0/1 # default: 0, affects all queries, all aliases
reconn_att: <int> # attempt reconnects this many times. default: 3
reconn_sleep: <int> # initial sleep seconds between reconnect attempts.
# doubles every attempt. default: 1
attr: # connection attributes. Only AutoCommit at this time
AutoCommit: 0/1 # default: 1
## You must define at least one connection alias
connections:
<conn_alias>:
user: <user>
pass: <password>
dsn: '<DSN>' # MySql Example: DBI:mysql:<DBNAME>:<DBHOST>
# PostgreSQL Example: DBI:Pg:dbname=<DBNAME>
# see: perldoc DBI, perldoc DBD::Pg, perldoc DBD::mysql
# for descriptions of valid DSNs
## These attributes and config are all optional, and use the default from above
attr:
AutoCommit: 0/1
config:
debug: 0/1 # only affects this connection
=head1 USAGE
This module can be used either pseudo-OO or static on multiple
databases. I say pseudo-OO, because you don't call new: this module
auto-vivicates a singleton object whenever you connect for the first
time.
=over
lib/Activator/DB.pm view on Meta::CPAN
Mandatory Arguments:
sql : sql statement string
bind : bind values arrayref
Optional Arguments:
conn => alias of the db connection (default is 'default')
NOTE: this changes the connection alias for all future queries
attr => hashref of attributes to use for ONLY THIS QUERY
Supported: AutoCommit
debug => pretty print sql debugging lines
# NOT YET SUPPORTED
slice => possible future support for DBI::getall_hashref
max_rows => possible future support for DBI::getall_hashref
Examples:
=over
=item ## Simple query:
my @row = $db->getrow( $sql );
=item ## Needy query:
my $res = $db->do( $sql, $bind,
connect => 'altdb', # changes the alias for future connections!
attr => { AutoCommit => 0, },
debug => 1,
);
=back
=head2 Query Failures & Errors
All query methods die on failure, and must be wrapped in a try/catch block.
eval {
Activator::DB->query_method( $sql, $bind, @args );
lib/Activator/DB.pm view on Meta::CPAN
##
## Throws
## connect.failure - on connect failure
## dbi.failure - on failure of DBI::selectcol_arrayref
##
## =cut
##
## sub getcol_arrayref {
## my ( $sql, $bind, $colsref ) = @_;
##
## $self->{debug_start} = [ gettimeofday ];
##
## my $colref;
##
## my $dbh = &get_dbh(); # may throw connect.failure
##
## eval {
## $colref
## = $dbh->selectcol_arrayref( $sql, { Columns => $colsref },
## @$bind );
## };
## if ( $@ ) {
## Activator::Exception::DB->throw( 'dbi', 'failure', $dbh->errstr || $@);
## }
##
## $self->_get_query_debug( 'getcol_arrayref', @_ );
##
## return $colref;
## }
##
## =item B<getall_hr>($sql, $bind, $key_field)
##
## Prepare and Execute a SQL statement on the default database, and
## call DBI::fetchall_hashref(),
## returning a reference to a hash containing one hashref for each row.
##
lib/Activator/DB.pm view on Meta::CPAN
## connect.failure - failure to connect to database
## prepare.failure - failure to prepare a query for database
## execute.failure - failure to execute a query on database
## sth.failure - failure on fetch
##
## =cut
##
## sub getall_hr {
## my ( $sql, $bind, $key_field ) = @_;
##
## $self->{debug_start} = [ gettimeofday ];
##
## my $sth = &_get_sth( $sql, $bind );
##
## my $rv = $sth->fetchall_hashref( $key_field );
##
## $sth->finish();
##
## $self->_get_query_debug( 'getall_hr', @_ );
##
## return $rv;
## }
lib/Activator/Log.pm view on Meta::CPAN
Activator::Log->logwarn( $msg );
Activator::Log->logdie( $msg );
Activator::Log->error_warn( $msg );
Activator::Log->error_die( $msg );
Activator::Log->logcarp( $msg );
Activator::Log->logcluck( $msg );
Activator::Log->logcroak( $msg );
Activator::Log->logconfess( $msg );
Activator::Log->is_trace()
Activator::Log->is_debug()
Activator::Log->is_info()
Activator::Log->is_warn()
Activator::Log->is_error()
Activator::Log->is_fatal()
See the L<Log::Log4perl> documentation for more details.
=head1 CONFIGURATION
=head2 Log::Log4perl
lib/Activator/Log.pm view on Meta::CPAN
Note that you can also initialize an instance of this module with the
same affect:
Activator::Log->new( $level );
=head1 DISABLING DEBUG OR TRACE BY MODULE
By default, this module will print all C<DEBUG> and C<TRACE> log messages
provided that the current log level is high enough. However, when
developing it is convenient to be able to turn debugging/tracing on
and off on a per-module basis. The following examples show how to do
this.
=head2 Turn debugging OFF on a per-module basis
Activator:
Log:
DEBUG:
'My::Module': 0 # My::Module will now prove "silence is bliss"
=head2 Turn debugging ON on a per-module basis
Activator:
Log:
DEBUG:
FORCE_EXPLICIT: 1
'My::Module': 1 # only My::Module messages will be debugged
TRACE:
FORCE_EXPLICIT: 1
'Other::Module': 1 # only Other::Module messages will be traced
=head2 Disabling Caveats
Note that the entire Activator framework uses this module, so use
FORCE_EXPLICIT with caution, as you may inadvertantly disable logging
from a package you DO want to hear from.
lib/Activator/Log.pm view on Meta::CPAN
if ( $logger_label ) {
$logger = Log::Log4perl->get_logger( $logger_label );
}
$logger->info( $msg );
}
sub DEBUG {
my ( $pkg, $msg, $logger_label ) = @_;
my $caller = caller;
my $self = &new( 'Activator::Log' );
my $debug = &_enabled( 'DEBUG', $caller );
if ( $debug ) {
$msg = _get_static_arg( $pkg, $msg );
my $logger = $self->{DEFAULT_LOGGER};
if ( $logger_label ) {
$logger = Log::Log4perl->get_logger( $logger_label );
}
$logger->debug( $msg );
}
}
sub TRACE {
my ( $pkg, $msg, $logger_label ) = @_;
my $caller = caller;
my $self = &new( 'Activator::Log' );
my $trace = &_enabled( 'TRACE', $caller );
if ( $trace ) {
$msg = _get_static_arg( $pkg, $msg );
lib/Activator/Log.pm view on Meta::CPAN
sub is_warn {
my $self = &new( 'Activator::Log' );
return $self->{DEFAULT_LOGGER}->is_warn();
}
sub is_info {
my $self = &new( 'Activator::Log' );
return $self->{DEFAULT_LOGGER}->is_info();
}
sub is_debug {
my $self = &new( 'Activator::Log' );
return $self->{DEFAULT_LOGGER}->is_debug();
}
sub is_trace {
my $self = &new( 'Activator::Log' );
return $self->{DEFAULT_LOGGER}->is_trace();
}
sub logwarn {
my ( $pkg, $msg ) = @_;
my $self = &new( 'Activator::Log' );
lib/Activator/Options.pm view on Meta::CPAN
WARN( "Skipped invalid environment variable $env_key. Key '$opt_key' for realm '$opt_realm' unchanged");
}
}
}
# forced overrides from config files
my $overrides = $self->{REGISTRY}->get_realm( 'overrides' );
DEBUG( 'processing overrides: '.Dumper( $overrides ));
# NOTE: bad (typo) keys could be in overrides. Someday,
# Activator::Registry will allow debug mode so we can state
# show this.
if ( exists( $overrides->{ $realm } ) ) {
$self->{REGISTRY}->register_hash( 'right', $overrides->{ $realm }, $realm );
}
# now that realm is set, make sure our $opts points to it
$opts = $self->{REGISTRY}->get_realm( $realm );
# Override any provided command line options into this realm.
# Strips known options out of \@ARGV
lib/Activator/Options.pm view on Meta::CPAN
Throws C<Activator::Exception::Option> when arg is invalid (which at this
time is only when a barewod arg of '=' is detected).
=cut
sub get_args {
my ( $pkg, $argv_raw ) = @_;
my $self = &new( @_ );
# quick and dirty check for debug mode
if( grep /^--?debug$/, @$argv_raw ) {
Activator::Log->level('DEBUG');
DEBUG('Entering debug mode');
}
if ( defined( $self->{ARGV} ) || defined( $self->{BAREWORDS} ) ) {
DEBUG("skipping ARGV reprocessing");
return ( $self->{ARGV}, $self->{BAREWORDS} );
}
DEBUG("got ARGV: ". join(' ', @$argv_raw ));
# use refs to insure that that $self->{ARGV} and
lib/Activator/Options.pm view on Meta::CPAN
}
# save these so we don't have to do it again
$self->{ARGV} = $argv;
$self->{BAREWORDS} = $barewords;
return ( $argv, $barewords );
}
# Helper to split an arg into key/value. Returns ($key, $value), where
# $value is undef if the argument is flag format (--debug), undef if
# it is a bareword ( foo ) and '--' if it is the arguments terminator
# symbol.
#
sub _get_arg {
my ( $self, $arg ) = @_;
if ( $arg !~ /^-(-)?/ ) {
return;
}
lib/Catalyst/Plugin/Activator/Config.pm view on Meta::CPAN
=cut
sub load_config {
my $c = shift;
my $ref = shift;
my ( $file, $config ) = %$ref;
$c->config( $config );
$c->log->debug( qq(Loaded Config "$file") )
if $c->debug;
return;
}
=head2 find_files
This method determines the potential file paths to be used for config loading.
It returns an array of paths (up to the filename less the extension) to pass to
L<Config::Any|Config::Any> for loading.
share/apache2/conf/httpd.conf.tt view on Meta::CPAN
# ErrorLog: The location of the error log file.
# If you do not specify an ErrorLog directive within a <VirtualHost>
# container, error messages relating to that virtual host will be
# logged here. If you *do* define an error logfile for a <VirtualHost>
# container, that host's errors will be logged there and not here.
#
ErrorLog logs/error_log
#
# LogLevel: Control the number of messages logged to the error_log.
# Possible values include: debug, info, notice, warn, error, crit,
# alert, emerg.
#
LogLevel warn
#
# The following directives define some format nicknames for use with
# a CustomLog directive (see below).
#
LogFormat "%h %l %u %t \"%r\" %>s %b \"%{Referer}i\" \"%{User-Agent}i\"" combined
LogFormat "%h %l %u %t \"%r\" %>s %b" common
share/conf/default-project.yml view on Meta::CPAN
# this is the default realm, and by default we don't define realms in this file
#
act_config_no_realms: 1
#
# default to the production realm
#
realm: production
#
# global debug flag: see perldoc Activator::Log for more specifics on debug logging.
#
debug: 1
#
# This is the name of the project, most likely the top of your perl
# namespace for a catalyst app, i.e.: MyApp
#
project_name:
#
# this value used for directories and filenames, i.e.: myapp
#
t/Config-02.t view on Meta::CPAN
use Data::Dumper;
use IO::Capture::Stderr;
#Activator::Log->level( 'DEBUG' );
$ENV{ACT_CONFIG_project} = 'test';
my $proj_dir = "$ENV{PWD}/t/data/test_project";
my $user_yml = "$ENV{USER}.yml";
system( qq( cp $proj_dir/USER.yml $proj_dir/$user_yml));
@ARGV = (# '--debug', # debug this test: doesn't break tests
'--realm=realm1', "--conf_path=$proj_dir", '--foo="set from args"',
'bare', '--bar=baz', '--', 'bare2', '--name=activation' );
my $config = Activator::Config->get_config( \@ARGV);
# make sure recognized options stripped
ok( @ARGV == 4, '@ARGV has correct count' );
ok( $ARGV[0] eq 'bare' &&
$ARGV[1] eq '--' &&
$ARGV[2] eq 'bare2' &&
[],
connect => 'def', # should go back to $testdb1
seq => 't1_id_seq', # for Pg, ignored for mysql
);
} "do_id doesn't die";
ok( $id && $id == 2, 'can insert' );
ok( $db->{cur_alias} eq $testdb1, "alias set to $testdb1 using 'def'");
# select the new row
lives_ok {
@row = Activator::DB->getrow( "select * from t1 where id='$id'", [], connect => 'def', debug => 1 );
} "getrow doesn't die";
ok( $row[0] eq '2' && $row[1] eq 'd1_t1_r2_c1' && $row[2] eq 'd1_t1_r2_c2', 'can select new row');
# test "do"
lives_ok {
$res = $db->do( "delete from t1 where id='$id'" );
} "do doesn't die";
ok( $res == 1, 'do affects corect num of rows');
lives_ok {
@row = $db->getrow( "select * from t1 where id='$id'" );
t/Options-02.t view on Meta::CPAN
use Data::Dumper;
use IO::Capture::Stderr;
#Activator::Log->level( 'DEBUG' );
$ENV{ACT_OPT_project} = 'test';
my $proj_dir = "$ENV{PWD}/t/data/test_project";
my $user_yml = "$ENV{USER}.yml";
system( qq( cp $proj_dir/USER.yml $proj_dir/$user_yml));
@ARGV = (# '--debug', # debug this test: doesn't break tests
'--realm=realm1', "--conf_path=$proj_dir", '--foo="set from args"',
'bare', '--bar=baz', '--', 'bare2', '--name=activation' );
my ( $opts, $args ) = Activator::Options->get_opts( \@ARGV);
# make sure recognized options stripped
ok( @ARGV == 4, '@ARGV has correct count' );
ok( $ARGV[0] eq 'bare' &&
$ARGV[1] eq '--' &&
$ARGV[2] eq 'bare2' &&
t/data/DB-test.yml view on Meta::CPAN
'Activator::DB':
# for testing config file Log4perl setup
# log4perl:
# 'log4perl.logger.Activator.DB' : 'WARN, Screen'
# 'log4perl.appender.Screen' : 'Log::Log4perl::Appender::Screen'
# 'log4perl.appender.Screen.layout' : 'Log::Log4perl::Layout::PatternLayout'
# 'log4perl.appender.Screen.layout.ConversionPattern' : 'YAML %d{yyyy-mm-dd HH:mm:ss.SSS} [%p] %m (%M %L)%n'
default:
connection: test1_mysql
config:
debug: 0
debug_connection: 0
debug_attr: 0
connections:
test1_mysql:
user: act_db_test_user
pass: act_db_test_pass
dsn: 'DBI:mysql:act_db_test1:localhost'
test2_mysql:
user: act_db_test_user
pass: act_db_test_pass
dsn: 'DBI:mysql:act_db_test2:localhost'
( run in 1.388 second using v1.01-cache-2.11-cpan-49f99fa48dc )