Activator
view release on metacpan or search on metacpan
lib/Activator/Config.pm view on Meta::CPAN
# make sure we can use ENV vars
my $skip_env = $ENV{ACT_CONFIG_skip_env};
$realm ||=
$self->{ARGV}->{realm} ||
( $skip_env ? undef : $ENV{ACT_CONFIG_realm} ) ||
'default';
if ( ref( $realm ) ) {
Activator::Exception::Config->throw( 'realm_specified_more_than_once', Dumper( $realm ) );
}
if ( $realm ne 'default' ) {
Activator::Registry->set_default_realm( $realm );
}
# setup or get the merged YAML configuration settings from files
# into the registry
my $config = $self->{REGISTRY}->get_realm( $realm );
# first call
if ( !keys %$config ) {
# define valid config from config files
try eval {
$self->_process_config_files( $realm, $skip_env, $project_is_arg );
};
if ( catch my $e ) {
$e->rethrow;
}
# read environment variables, set any keys found
if ( !$skip_env ) {
my ( $env_key, $env_realm );
foreach my $env_key ( keys %ENV ) {
next unless $env_key =~ /^ACT_CONFIG_(.+)/;
$opt_key = $1;
$opt_realm = $realm;
lib/Activator/Config.pm view on Meta::CPAN
return;
}
if ( $arg eq '--' ) {
return $arg;
}
my ( $key, $value ) = split /=/xms, $arg, 2;
if ( !defined $key ) {
Activator::Exception::Config->throw( 'argument',
'invalid',
$arg );
}
# clean up key
$key =~ s/^--?//;
# clean up value, if quoted
if ( defined $value ) {
$value =~ s/^"//;
lib/Activator/Config.pm view on Meta::CPAN
# Merge config files into this objects Activator::Registry object
sub _process_config_files {
my ( $pkg, $realm, $skip_env, $project_is_arg ) = @_;
my $self = &new( @_ );
# figure out what project we are working on
my $project =
$self->{ARGV}->{project} ||
( $project_is_arg ? $self->{BAREWORDS}->[-1] : undef ) ||
( $skip_env ? undef : $ENV{ACT_CONFIG_project} ) ||
Activator::Exception::Config->throw( 'project', 'missing' );
# process these files:
# $ENV{USER}.yml
# <realm>.yml - realm specific settings and defaults
# <project>.yml - project specific settings and defaults
# org.yml - top level organization settings and defaults
# in one of these paths, if set
# --conf_file= : use $self->{ARGV}->{conf_file} (which could be an arrayref )
# ACT_CONFIG_conf_file= : comma separated list of files
my $conf_path = $self->{ARGV}->{conf_path};
if ( ! $conf_path ) {
$conf_path = ( $skip_env ? undef : $ENV{ACT_CONFIG_conf_path} );
if ( !$conf_path ) {
ERROR( "Neither ACT_CONFIG conf_path env var nor --conf_path set");
Activator::Exception::Config->throw( 'conf_path', 'missing' );
}
else {
INFO( "Using ACT_CONFIG_conf_path env var: $conf_path");
}
}
else {
INFO( "Using conf_path argument: $conf_path");
}
my @search_paths = split ':', $conf_path;
lib/Activator/Config.pm view on Meta::CPAN
# now that we have all the files, import 'em! This is a super long
# winded but safe "left precedence" merge of all files
my ( $user_config, $realm_config, $project_config, $org_config );
try eval {
if ( exists( $files->{user}->{file} ) ) {
$user_yml = YAML::Syck::LoadFile( $files->{user}->{file} );
}
};
if ( catch my $e ) {
Activator::Exception::Config->throw( 'user_config', 'invalid', $e );
}
try eval {
if ( exists( $files->{realm}->{file} ) ) {
$realm_yml = YAML::Syck::LoadFile( $files->{realm}->{file} );
}
};
if ( catch my $e ) {
Activator::Exception::Config->throw( 'realm_config', 'invalid', $e );
}
try eval {
if ( exists( $files->{project}->{file} ) ) {
$project_yml = YAML::Syck::LoadFile( $files->{project}->{file} );
}
};
if ( catch my $e ) {
Activator::Exception::Config->throw( 'project_config', 'invalid', $e );
}
try eval {
if ( exists( $files->{org}->{file} ) ) {
$org_yml = YAML::Syck::LoadFile( $files->{org}->{file} );
}
};
if ( catch my $e ) {
Activator::Exception::Config->throw( 'org_config', 'invalid', $e );
}
if ( $realm ne 'default' ) {
if ( defined( $user_yml ) && exists( $user_yml->{ $realm } ) ) {
$self->{REGISTRY}->register_hash( 'left', $user_yml->{ $realm }, $realm );
DEBUG('Registered: ' . $files->{user}->{file} . " for realm $realm" );
}
if ( defined( $realm_yml ) && exists( $realm_yml->{ $realm } ) ) {
$self->{REGISTRY}->register_hash( 'left', $realm_yml->{ $realm }, $realm );
lib/Activator/Config.pm view on Meta::CPAN
if ( defined( $org_yml ) && exists( $org_yml->{overrides} ) ) {
$self->{REGISTRY}->register_hash( 'left', $org_yml->{overrides}, 'overrides' );
DEBUG('Registered: ' . $files->{org}->{file} . " overrides" );
}
# make sure all is kosher
my $test = $self->{REGISTRY}->get_realm( $realm );
if ( !keys %$test ) {
DEBUG( Data::Dumper->Dump( [ $self->{REGISTRY} ], [ qw/ registry / ] ) );
ERROR( "After processing, '$realm' realm should not be empty, but it is!");
Activator::Exception::Config->throw('realm', 'empty', $realm);
}
}
# Override any options in $config with the values in $argv. Sets non-existent keys.
#
# Arguments:
# $config : hashref to the options for $realm
# $argv : arrayref to command line arguments. All recognized options are removed.
#
sub _argv_override {
lib/Activator/DB.pm view on Meta::CPAN
$self->{last_alias} = $self->{cur_alias};
$self->{cur_alias} = $self->{default}->{connection};
}
my $conn;
try eval {
$conn = $self->_get_cur_conn();
};
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}");
lib/Activator/DB.pm view on Meta::CPAN
try eval {
$conn->{dbh} = DBI->connect( $conn->{dsn},
$conn->{user} || '',
$conn->{pass} || '',
$conn->{attr}
);
};
if ( catch my $e ) {
Activator::Exception::DB->throw( 'dbh',
'connect',
"$e " .
Data::Dumper->Dump( [ $conn ], [ 'connection' ] )
);
}
# 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;
}
sub _init {
my ( $self ) = @_;
$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 },
lib/Activator/DB.pm view on Meta::CPAN
PrintError => 0,
HandleError => Exception::Class::DBI->handler,
AutoCommit => 1,
};
$self->{connections} = {};
# setup the current alias key
$self->{cur_alias} =
$self->{default}->{connection} =
$setup->{default}->{connection} ||
Activator::Exception::DB->throw( 'connect',
'config',
'default: connection not set!'
);
# setup default attributes. NOTE: even though we only support
# AutoCommit, this block can easily be extended for other
# attributes.
foreach my $key ( 'AutoCommit' ) {
my $value = $setup->{default}->{attr}->{ $key };
$self->{ $key } =
lib/Activator/DB.pm view on Meta::CPAN
try eval { $dbh->ping(); };
if ( catch my $e ) {
$reconn_att--;
sleep $reconn_sleep;
$reconn_sleep *= 2;
} else {
return 1;
}
}
ERROR( "connection to $conn->{alias} appears to be dead" );
Activator::Exception::DB->throw( 'ping', 'failure' );
}
# _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 ) = @_;
my $bind = $bindref || [];
my $self = $pkg;
my $connect_to = $args->{connect};
# handle static calls
if ( !( Scalar::Util::blessed($self) && $self->isa( 'Activator::DB') ) ) {
if ( $connect_to ) {
$self = Activator::DB->connect( $connect_to );
}
else {
Activator::Exception::DB->throw( 'connect', 'missing');
}
}
# static or OO, respect the connect
if ( $connect_to ) {
$self->{cur_alias} = $connect_to;
}
# This next line insures that $self refers to the singleton object
$self = $self->connect( $self->{cur_alias} );
my $conn = $self->_get_cur_conn()
or Activator::Exception::DB->throw( 'connection',
'failure',
"_explode couldn't get connection for alias '$self->{cur_alias}'");
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
lib/Activator/DB.pm view on Meta::CPAN
try eval {
$sth = $conn->{dbh}->prepare_cached( $sql, $attr );
};
if ( catch my $e ) {
$self->_ping();
try eval {
$sth = $conn->{dbh}->prepare_cached( $sql, $attr );
};
if ( catch my $e ) {
Activator::Exception::DB->throw( 'sth',
'prepare',
$e . " SQL: " .
$self->_get_sql( $sql, $bind )
);
}
}
my $res;
try eval {
$res = $sth->execute( @$bind );
};
if ( catch my $e ) {
Activator::Exception::DB->throw( 'sth',
'execute',
$e . " SQL: " .
$self->_get_sql( $sql, $bind )
);
}
if ( $want_exec_result ) {
$sth->finish();
return $res;
}
lib/Activator/DB.pm view on Meta::CPAN
$self->_start_timer();
my $conn = $self->_get_cur_conn();
my ( $sth, $e );
try eval {
$sth = $self->_get_sth( $sql, $bind, $attr );
};
if ( catch my $e ) {
$e->rethrow;
}
my ( @row, $row, $rows );
if ( $fn eq 'getrow') {
try eval {
@row = $sth->fetchrow_array();
$sth->finish();
};
}
elsif ( $fn eq 'getrow_arrayref' ) {
lib/Activator/DB.pm view on Meta::CPAN
};
}
elsif ( $fn eq 'getall_hashrefs' ) {
try eval {
$row = $sth->fetchall_arrayref( {} );
$sth->finish();
};
}
if ( catch my $e ) {
Activator::Exception::DB->throw( 'sth',
'fetch',
$e .
$self->_get_sql( $sql, $bind )
);
}
# clean up return value for total consistency.
if ( !defined( $row ) ) {
if ( $fn eq 'getrow_hashref' ) {
lib/Activator/DB.pm view on Meta::CPAN
my ( $self, $bind, $attr ) = $pkg->_explode( $bindref, \%args );
my $conn = $self->_get_cur_conn();
$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 {
Activator::Exception::DB->throw('execute',
'failure',
$self->_get_sql( $sql, $bind ) .
" did not cause an insert"
);
}
}
sub do {
my ( $pkg, $sql, $bindref, %args ) = @_;
my ( $self, $bind, $attr, $alt_error ) = $pkg->_explode( $bindref, \%args );
my $conn = $self->_get_cur_conn();
$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;
}
lib/Activator/DB.pm view on Meta::CPAN
sub rollback {
my ( $self ) = @_;
my $conn = $self->_get_cur_conn();
try eval {
$conn->{dbh}->rollback;
};
catch my $e;
$conn->{dbh}->{AutoCommit} = 1;
if ( $e ) {
$e->rethrow;
}
}
sub as_string {
my ( $pkg, $sql, $bind ) = @_;
return Activator::DB->_get_sql( $sql, $bind );
}
sub _start_timer {
my ( $self ) = @_;
lib/Activator/DB.pm view on Meta::CPAN
# catch the error
}
We highly recommend (and use extensively)
L<Exception::Class::TryCatch> which allows this syntactic sugar:
try eval {
Activator::DB->query_method( $sql, $bind, @args );
};
if ( catch my $e ) {
# rethrow, throw a new error, print something, AKA: handle it!
}
Errors Thrown:
connection failure - could not connect to database
sql missing - query sub called without 'sql=>' argument
connect missing - static call without 'connect=>' argument
prepare failure - failure to $dbh->prepare
execute failure - failure to $dbh->execute
alias_config missing - connection alias has no configuration
lib/Activator/DB.pm view on Meta::CPAN
##
## =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
lib/Activator/Dictionary.pm view on Meta::CPAN
$dict->lookup( "$key_prefix.$col" ); # succeeds
For this reason, it is required that you not use period in the
C<key_prefix> column.
=head2 Failure Mode
Instead of returning undef for non-existent keys, you can configure
this module to fail via one or more of these methods:
die : throws Activator::Exception::Dictionary('key', 'missing')
key : returns the requested key itself
'' : returns empty string
<lang> : return the value for <lang> in the requested realm
<realm> : return the value for <realm>
Examples:
$db->lookup( $key, $realm1 ); # value does not exist
fail_mode: [ realm2, de, key ]
return value for $key in realm2 if it exists
return value for $key in realm1 in german if it exists
return $key
fail_mode: [ realm2, die ]
return value for $key in realm2 if it exists
throw Activator::Exception::Dictionary
fail_mode: [ realm2, realm3 ]
return value for $key in realm2 if it exists
return value for $key in realm3 if it exists
return undef (fallback to default failure mode)
fail_mode: [ '' ]
return empty string
lib/Activator/Dictionary.pm view on Meta::CPAN
$dict->lookup( $key2, $realm );
Static Usage:
Activator::Dictionary->use_lang( $lang );
Activator::Dictionary->lookup( $key, $realm );
Activator::Dictionary->lookup( $key2, $realm );
Returns the value for C<$key> in C<$realm>. Returns C<undef> when the
key does not exist, but you can configure this module to do something
different (see L<Failure Mode> below). If realm does not exist, throws
C<Activator::Exception::Dictionary> no matter the failure mode.
=cut
sub lookup {
my ($pkg, $key, $realm ) = @_;
my $self = &get_dict( $pkg );
my $lang = $self->{cur_lang};
$realm ||= $self->{config}->{default_realm};
if ( !defined( $key ) ) {
Activator::Exception::Dictionary->throw( 'key', 'undefined');
}
if ( !exists( $self->{ $lang }->{ $realm } ) ) {
Activator::Exception::Dictionary->throw( 'realm', 'undefined', $realm);
}
if ( exists( $self->{ $lang }->{ $realm }->{ $key } ) ) {
my $ret = $self->{ $lang }->{ $realm }->{ $key };
DEBUG( "Found key '$key'. value: $ret");
return $ret;
}
# At this point, there was no value for the given key in the given
# realm. Honor configured failure mode.
lib/Activator/Dictionary.pm view on Meta::CPAN
}
my %tried = ( $lang => 1, $realm => 1 );
my @modes = @{ $self->{config}->{fail_mode} };
DEBUG( "Trying modes: ". Dumper( \@modes ) );
foreach my $mode ( @modes ) {
next if $tried{ $mode };
$tried{ $mode } = 1;
DEBUG( "Trying fail_mode '$mode'");
if ( $mode eq 'die' ) {
DEBUG( "die means throw exception");
Activator::Exception::Dictionary->throw('key', 'missing');
}
if ( $mode eq '' ) {
DEBUG( "returning empty string");
return '';
}
if ( $mode eq 'key' ) {
DEBUG( "returning key '$key'");
return $key;
lib/Activator/Dictionary.pm view on Meta::CPAN
}
DEBUG( "No valid fail_mode found. Returning undef");
return;
}
=head2 get_dict( $lang )
Returns a reference to the Activator::Dictionary object. Sets all
future lookups to use the $lang passed in. If $lang is not passed in,
uses 'Activator::Dictionary' registry value for 'default_lang'. If
$lang cannot be determined, throws Activator::Exception::Dictionary.
=cut
sub get_dict {
my ($pkg, $lang ) = @_;
my $self = &new( @_ );
# first call
if( !exists $self->{config} ) {
$self->_init_config();
}
# first call for $lang
$lang ||= $self->{cur_lang} || $self->{config}->{default_lang};
if ( !$lang ) {
Activator::Exception::Dictionary->throw( 'lang', 'undefined' );
}
if( !exists $self->{ $lang } ) {
try eval {
$self->_init_lang( $lang );
};
if ( catch my $e ) {
Activator::Exception::Dictionary->throw( 'init_lang', 'failed', $e );
}
}
$self->{cur_lang} = $lang;
return $self;
}
=head2 new( $lang )
lib/Activator/Dictionary.pm view on Meta::CPAN
$self->{config}->{default_realm} = $config->{default_realm} || 'default';
$self->{config}->{default_lang} = $config->{default_lang} || 'en';
$self->{config}->{dict_tables} = $config->{dict_tables};
$self->{config}->{dict_files} = $config->{dict_files};
$self->{config}->{db_alias} = $config->{db_alias};
$self->{config}->{fail_mode} = $config->{fail_mode};
if ( !( defined( $self->{config}->{dict_files} ) ||
defined( $self->{config}->{dict_tables} )
) ) {
Activator::Exception::Dictionary->throw( 'tables_or_files', 'undefined' );
}
if ( defined( $self->{config}->{dict_tables} ) &&
!defined( $self->{config}->{db_alias} ) ) {
Activator::Exception::Dictionary->throw( 'db_alias', 'missing' );
}
}
sub _init_lang {
my ($self, $lang) = @_;
my $processed = 0;
# import all the realms for this language from the db
if ( defined( $self->{config}->{dict_tables} ) ) {
my ( $sql, $rows, $row, $col, $realm, $key );
foreach my $table ( @{ $self->{config}->{dict_tables} } ) {
$sql = "SELECT * FROM $table WHERE lang = ?";
try eval {
$rows = Activator::DB->getall_hashrefs( $sql, [ $lang ], connect => 'def' );
};
if ( catch my $e ) {
Activator::Exception::Dictionary->throw( 'dict_tables',
'misconfigured',
"Activator::Dictionary caught: \n$e" );
}
foreach $row ( @$rows ) {
foreach $col ( keys %$row ) {
if ( $col !~/_id$|realm|lang|key_prefix|last_modified/ ) {
$realm = $row->{realm};
$key = "$row->{key_prefix}.$col";
if ( exists( $self->{ $lang }->{ $realm }->{ $key } ) ) {
local $Log::Log4perl::caller_depth;
lib/Activator/Dictionary.pm view on Meta::CPAN
my @files = grep { /^[^\.]/ && -f "$dir_loc/$_" } readdir(DIR);
closedir DIR;
my ($file, $realm, $key, $value);
foreach $file ( @files ) {
if ( $file !~ /.dict$/ ) {
WARN("Non-dictionary file '$file' found in lang dir $dir_loc");
next;
}
open DICT, "<$dir_loc/$file" ||
Activator::Exception::Dictionary->throw('dict_file',
'unreadable',
"$dir_loc/$file" );
$file =~ /(.+)\.dict$/;
$realm = $1;
while (<DICT>) {
chomp;
next if /^\s*$/;
next if /^\s*#/;
s/^\s+//;
lib/Activator/Emailer.pm view on Meta::CPAN
$tt_vars->{'Activator_Emailer_format'} = 'text';
$tt_vars->{html_header} = $self->{html_header};
$tt_vars->{html_body} = $self->{html_body};
$tt_vars->{html_footer} = $self->{html_footer};
my $text_body = '';
my $html_body = '';
my $tt = Template->new( $self->{tt_options} ) ||
Activator::Exception::Emailer->throw( 'tt_new_error', $Template::ERROR, "\n" );
$tt->process( $self->{email_wrap}, $tt_vars, \$text_body ) ||
Activator::Exception::Emailer->throw( 'tt_process_error', $tt->error(), "\n" );
$tt_vars->{'Activator_Emailer_format'} = 'html';
$tt->process( $self->{email_wrap}, $tt_vars, \$html_body ) ||
Activator::Exception::Emailer->throw( 'tt_process_error', $tt->error(), "\n" );
my @email_args = (
From => $self->{From},
To => $self->{To},
Cc => $self->{Cc},
Subject => $self->{Subject},
SkipBad => 1,
);
push @email_args, ( Type => 'multipart/alternative' );
lib/Activator/Emailer.pm view on Meta::CPAN
DEBUG("----------------------------------------\nCreated email:\n".
$email->as_string .
"\n----------------------------------------"
);
try eval {
my $retval = $self->{sender}->send( $email->as_string);
die $retval unless $retval;
};
if ( catch my $e ) {
Activator::Exception::Emailer->throw( 'send_error', $e );
}
}
=head2 attach( %args )
Attach an item to this email. When C<send()> is called, C<%args> is
just passed through to the L<MIME::Lite> attach function.
=cut
lib/Activator/Exception.pm view on Meta::CPAN
package Activator::Exception;
use warnings;
use strict;
# override throw to accept shortcut
sub throw {
my ( $pkg, $obj, $code, $extra ) = @_;
$pkg->SUPER::throw( error => $obj,
code => $code,
extra => $extra );
}
# TODO: make this thing do dictionary/lexicon lookups, with support in
# $extra as well. Maybe $extra could "dict-><key>".
# TODO: make this take 2 args, update all of Activator
# NOTE: this is always called from SUPER::as_string
lib/Activator/Options.pm view on Meta::CPAN
--conf_path=<paths_to_conf_dir> # colon separated list
--conf_files=<conf_files> # comma separated list
$ENV{ACT_OPT_conf_path}
$ENV{ACT_OPT_project_home}/.<$ENV{ACT_OPT_project}>.d/
$ENV{HOME}/.<$ENV{ACT_OPT_project}>.d/
/etc/<$ENV{ACT_OPT_project}>.d/
/etc/activator.d/ # useful for org.yml
It is up to the script to define what C<project> is by insuring that
C<$ENV{ACT_OPT_project}> is set. This module will throw
C<Activator::Exception::Option> it is not set by you or passed in as a
command line argument, so you could force the user to use the
C<--project> option if you like.
=head2 Realms
This module supports the concept of realms to allow multiple similar
configurations to override only the esential keys to "git 'er done".
=head2 Configuration Logic Summary
lib/Activator/Options.pm view on Meta::CPAN
# into the registry
my $opts = $self->{REGISTRY}->get_realm( $realm );
# first call
if ( !keys %$opts ) {
# define valid opts from config files
try eval {
$self->_process_config_for( $realm );
};
# _set_reg throws err if $realm is invalid
if ( catch my $e ) {
$e->rethrow;
}
# read environment variables, set any keys found
if ( !$skip_env ) {
my ( $env_key, $env_realm );
foreach my $env_key ( keys %ENV ) {
next unless $env_key =~ /^ACT_OPT_(.+)/;
$opt_key = $1;
$opt_realm = $realm;
lib/Activator/Options.pm view on Meta::CPAN
return;
}
if ( $arg eq '--' ) {
return $arg;
}
my ( $key, $value ) = split /=/xms, $arg, 2;
if ( !defined $key ) {
Activator::Exception::Options->throw( 'argument',
'invalid',
$arg );
}
# clean up key
$key =~ s/^--?//;
# clean up value, if quoted
if ( defined $value ) {
$value =~ s/^"//;
lib/Activator/Options.pm view on Meta::CPAN
# Merge config files into this objects Activator::Registry object
sub _process_config_for {
my ( $pkg, $realm ) = @_;
my $self = &new( @_ );
# figure out what project we are working on
my $project =
$self->{ARGV}->{project} ||
$ENV{ACT_OPT_project} ||
Activator::Exception::Options->throw( 'project', 'missing' );
# assemble a list of paths to look for config files
# TODO: look in all these places:
# --conf_path
# ACT_OPT_conf_path
# $ENV{ACT_OPT_project_home}/.<$ENV{ACT_OPT_project}>.d/
# $ENV{HOME}/.<$ENV{ACT_OPT_project}>.d/
# $ENV{HOME}/.activator.d/
# /etc/<$ENV{ACT_OPT_project}>.d/
# /etc/activator.d/
lib/Activator/Options.pm view on Meta::CPAN
# ACT_OPT_conf_file= : comma separated list of files
# $ENV{USER}.yml
# <realm>.yml - realm specific settings and defaults
# <project>.yml - project specific settings and defaults
# org.yml - top level organization settings and defaults
# For now, just use ~/.activator.d/$project : key/value is path/'where
# found', 'where found' being one of: hardcoded, env, or arg
my $dir = $self->{ARGV}->{conf_path} ||
$ENV{ACT_OPT_conf_path} ||
Activator::Exception::Options->throw( 'conf_path', 'missing');
my $search_paths = { $dir => 'arg' };
my $files = { user => { target => "$ENV{USER}.yml" },
realm => { target => "${realm}.yml" },
project => { target => "${project}.yml" },
org => { target => 'org.yml' } };
foreach my $path ( keys %$search_paths ) {
$path =~ s|/$||;
foreach my $which ( keys %$files ) {
my $target = $files->{ $which }->{target};
lib/Activator/Options.pm view on Meta::CPAN
# now that we have all the files, import 'em! This is a super long
# winded but safe "left precedence" merge of all files
my ( $user_config, $realm_config, $project_config, $org_config );
try eval {
if( exists( $files->{user}->{file} ) ) {
$user_yml = YAML::Syck::LoadFile( $files->{user}->{file} );
}
};
if ( catch my $e ) {
Activator::Exception::Options->throw( 'user_config', 'invalid', $e );
}
try eval {
if( exists( $files->{realm}->{file} ) ) {
$realm_yml = YAML::Syck::LoadFile( $files->{realm}->{file} );
}
};
if ( catch my $e ) {
Activator::Exception::Options->throw( 'realm_config', 'invalid', $e );
}
try eval {
if( exists( $files->{project}->{file} ) ) {
$project_yml = YAML::Syck::LoadFile( $files->{project}->{file} );
}
};
if ( catch my $e ) {
Activator::Exception::Options->throw( 'project_config', 'invalid', $e );
}
try eval {
if( exists( $files->{org}->{file} ) ) {
$org_yml = YAML::Syck::LoadFile( $files->{org}->{file} );
}
};
if ( catch my $e ) {
Activator::Exception::Options->throw( 'org_config', 'invalid', $e );
}
if ( defined( $user_yml ) && exists( $user_yml->{ $realm } ) ) {
$self->{REGISTRY}->register_hash( 'left', $user_yml->{ $realm }, $realm );
}
if ( defined( $realm_yml ) && exists( $realm_yml->{ $realm } ) ) {
$self->{REGISTRY}->register_hash( 'left', $realm_yml->{ $realm }, $realm );
}
lib/Activator/Options.pm view on Meta::CPAN
$self->{REGISTRY}->register_hash( 'left', $project_yml->{overrides}, 'overrides' );
}
if ( defined( $org_yml ) && exists( $org_yml->{overrides} ) ) {
$self->{REGISTRY}->register_hash( 'left', $org_yml->{overrides}, 'overrides' );
}
# make sure all is kosher
my $test = $self->{REGISTRY}->get_realm( $realm );
if ( !keys %$test ) {
Activator::Exception::Options->throw('realm', 'invalid', $realm);
}
}
# Override any options in $opts with the values in $argv. Sets non-existent keys.
#
# Arguments:
# $opts : hashref to the options for $realm
# $argv : arrayref to command line arguments. All recognized options are removed.
#
lib/Activator/Registry.pm view on Meta::CPAN
#### register $value to $key in default realm
Activator::Registry->register( $key, $value );
#### get value for $key from $realm
Activator::Registry->get( $key, $realm );
#### get value for $key from default realm
Activator::Registry->get( $key );
#### get a deep value for $key from default realm
#### this form throws exception for invalid keys
$key = 'top->deep->deeper';
try eval {
Activator::Registry->get( $key );
}
#### register YAML file into realm
Activator::Registry->register_file( $file, $realm );
#### register hash into realm
Activator::Registry->register_hash( $mode, $hashref, $realm );
lib/Activator/Registry.pm view on Meta::CPAN
if ( $mode eq 'left' ) {
Hash::Merge::set_behavior( 'LEFT_PRECEDENT' );
}
elsif ( $mode eq 'right' ) {
Hash::Merge::set_behavior( 'RIGHT_PRECEDENT' );
}
else {
# TODO: consider using custom precedence
#Hash::Merge::specify_behavior( $pkg->{SAFE_LEFT_PRECEDENCE} );
Activator::Exception::Registry->throw( 'mode', 'invalid' );
}
my $reg = $pkg->new();
$realm ||= $reg->{DEFAULT_REALM};
if ( !exists( $reg->{REGISTRY}->{ $realm } ) ) {
$reg->{REGISTRY}->{ $realm } = {};
}
my $merged = {};
try eval {
$merged = Hash::Merge::merge( $reg->{REGISTRY}->{ $realm }, $right );
};
# catch
if ( catch my $e ) {
Activator::Exception::Registry->throw( 'merge', 'failure', $e );
}
elsif( keys %$merged ) {
$reg->{REGISTRY}->{ $realm } = $merged;
}
}
=head2 get( $key, $realm )
Get the value for C<$key> within C<$realm>. If C<$realm> not defined
lib/Activator/Registry.pm view on Meta::CPAN
sub _deep_get {
my ($pkg, $keys, $realm, $reg_ref) = @_;
my $key = shift @$keys;
if ( @$keys == 0 ) {
if ( exists( $reg_ref->{ $key } ) ) {
return $reg_ref->{ $key };
}
else {
Activator::Exception::Registry->throw( 'key', 'invalid', $key );
}
}
if ( exists( $reg_ref->{ $key } ) ) {
return $pkg->_deep_get( $keys, $realm, $reg_ref->{ $key } );
}
else {
Activator::Exception::Registry->throw( 'key', 'invalid', $key );
}
}
=head2 get_realm( $realm )
Return a reference to hashref for an entire C<$realm>.
=cut
sub get_realm {
lib/Activator/Registry.pm view on Meta::CPAN
processed AFTER the passed in C<$replacements> are processed.
=cut
sub replace_in_realm {
my ($pkg, $realm, $replacements) = @_;
my $self = $pkg->new();
my $reg = $self->get_realm( $realm );
if ( !keys %$reg ) {
Activator::Exception::Registry->throw( 'realm', 'invalid', $realm );
}
TRACE("replacing (realm '$realm') ". Dumper($reg) . "\n ---- with ----\n". Dumper($replacements));
$self->replace_in_hashref( $reg, $replacements );
$self->replace_in_hashref( $reg, $reg );
TRACE("Done replacing. End result: ". Dumper($reg));
}
=head2 replace_in_hashref( $hashref, $replacements )
lib/Catalyst/Plugin/Activator/Exception.pm view on Meta::CPAN
package Catalyst::Plugin::Activator::Exception;
use strict;
use warnings;
use Activator::Log qw( :levels );
use Activator::Exception;
use Symbol;
*{Symbol::qualify_to_ref('throw', 'Catalyst')} = sub {
return &Catalyst::Plugin::Activator::Exception::throw( @_ );
};
sub throw {
my ($c, $e) = @_;
if ( !defined $e ) {
$e = new Activator::Exception('unknown');
}
if ( $e eq '' ) {
$e = new Activator::Exception('unknown');
}
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'" );
} "getrow doesn't die";
ok( @row == 0, 'do successfully deleted row');
# fail on static calls without connect string
throws_ok {
@row = Activator::DB->getrow( "select * from t1 where id='$id'" );
} 'Activator::Exception::DB', 'static call dies without connect arg';
throws_ok {
@row = Activator::DB->getrow( "sel from foo", [], connect => 'def');
} 'Activator::Exception::DB', 'invalid sql throws Activator::Exception::DB';
throws_ok {
@row = Activator::DB->getrow( "select * from t1", [], connect => 'defasdlkj');
} 'Activator::Exception::DB', 'invalid connect alias dies';
# get row as arrayref
lives_ok {
$rowref = $db->getrow_arrayref( "select * from t1" );
} "getrow_arrayref doesn't die after invalid connect attempt";
ok( ref($rowref) eq 'ARRAY', 'getrow_arrayref returns arrayref');
ok( @$rowref[0] eq '1' && @$rowref[1] eq 'd1_t1_r1_c1' && @$rowref[2] eq 'd1_t1_r1_c2', 'getrow_arrayref returns expected data');
t/Exception.t view on Meta::CPAN
#!/usr/bin/perl -w
use Test::More tests => 8;
use Activator::Exception;
use Exception::Class::TryCatch;
use Data::Dumper;
my $err;
try eval {
Activator::Exception->throw( 'MyObj', 'MyCode' );
};
catch $err;
ok( $err, "Can catch $err");
$err = undef;
try eval {
1;
};
ok( !$err, "Catch nothing when no error thrown");
try eval {
Activator::Exception->throw( 'MyObj', 'MyCode', 'MyExtra' );
};
catch $err;
ok( $err eq 'MyObj MyCode MyExtra', 'all fields in err string' );
try eval {
Activator::Exception::DB->throw( 'DbObj', 'DbCode', 'DbExtra' );
};
catch $err;
ok( $err, "Can catch subclass exception");
ok( $err eq 'DbObj DbCode DbExtra', 'subclass exception inherits fields' );
try eval {
die "text failure";
};
catch $err;
ok( $err, "Can catch random die");
t/Registry-oo.t view on Meta::CPAN
my $dne_value = $reg->get('dne_value');
ok( !defined( $dne_value ), 'non-existent key returns undef' );
# deep get
my $deep_key = 'deep_hash->level_1->level_2->level_3';
my $deep_val = $reg->get( $deep_key );
ok( $deep_val && $deep_val eq 'this is level 3', 'deep arrow syntax: value match' );
eval {
$deep_val = $reg->get( "${deep_key}->level_4" );
};
ok( defined $@, 'deep get of non-existent key throws exception' );
# deep register
my $success = $reg->register( $deep_key, 'modified' );
ok( $success, 'deep arrow syntax: register existing key returns true' );
$deep_val = $reg->get( $deep_key );
ok( $deep_val && $deep_val eq 'modified', 'deep arrow syntax: register value match' );
## # create a test file to reload
my $dyn_test_yaml_file = "$ENV{PWD}/t/data/Registry-dyn.yml";
( run in 0.533 second using v1.01-cache-2.11-cpan-496ff517765 )