Activator
view release on metacpan or search on metacpan
bin/activator.pl view on Meta::CPAN
WARN( "Couldn't process Template file '$config_file'");
next;
}
# $fq_dest_file = "$config->{sync_conf_dir}/$out";
my $tt = Template->new( { DEBUG => 1,
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 );
}
}
bin/activator.pl view on Meta::CPAN
$fq =~ m|share/apache2/(.+)\.tt$|;
my $out = $1;
return unless $out;
DEBUG( qq( processing $file into ).$config->{apache2}->{ServerRoot}.'/'.$out );
my $tt = Template->new( { DEBUG => 1,
ABSOLUTE => 1,
OUTPUT_PATH => $config->{apache2}->{ServerRoot},
}
);
$tt->process( $fq, $config, $out ) || Activator::Log->logdie( $tt->error()."\n");
# TODO: use some smart hueristics to properly chmod that which
# should be executable
#
#if( $out =~ m@/s?bin/|/init.d/@ ) {
# chmod 0755, $config->{apache2}->{ServerRoot}.'/'.$out
#}
}
# copy the default project config for a catalyst app to the correct
lib/Activator/DB.pm view on Meta::CPAN
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;
lib/Activator/DB.pm view on Meta::CPAN
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
=item *
Implemented as a singleton so each process is guranteed to be using no
more than one connection to each database from the pool.
=back
Disadvantages:
lib/Activator/DB.pm view on Meta::CPAN
=item *
Only tested with MySql and PostgreSQL
=back
=head1 CONFIGURATION
This module uses L<Activator::Registry> to automatically choose default
databases, and L<Activator::Log> to log warnings and errors.
=head2 Registry Setup (from Activator::Registry)
This module expects an environment variable ACT_REG_YAML_FILE to be
set. If you are utilizing this module from apache, this directive must
be in your httpd configuration:
SetEnv ACT_REG_YAML_FILE '/path/to/config.yml'
If you are using this module from a script, you need to insure that
lib/Activator/DB.pm view on Meta::CPAN
=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 );
};
if ($@) {
# 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
activator_db error - sub _warn_or_die() died without error args passed in
fetch failure - $sth->fetch* call failed
do failure - $dbh->do call failed
=head1 METHODS
=head2 getrow
=head2 getrow_arrayref
=head2 getrow_hashref
lib/Activator/Dictionary.pm view on Meta::CPAN
singleton that uses dictionary definintions from a simple
space-delimeted file or database table(s). The dictionary is
completely maintained in memory and loads realms and languages
dynamically on an as-needed basis, so this module may not be
appropriate for extremely large lexicons or for projects that create
large numbers of program instances. That being said, it can be
relatively memory efficient when used for a single language deployment
in an application that provides multiple language support.
An C<Activator::Dictionary> object can have multiple realms: that is, you
could have a 'web' dictionary for the website text, an 'error'
dictionary for backend job messages, and any number of other realms
needed for your application. This allows you to separate the
translatable texts from each other so that, for example, the web
frontend of your application could give a user friendly message using
the 'web' realm, and the backend could use the 'error' realm to log
something much more useful to a technician.
Note that there can be great amounts of complexity localizing language
within an application. This module is for the simple cases, where you
just have key/value lookups. If you need complex conjugations, object
sensitive pluralization, you should look into the existing
L<Locale::Maketext>, or the upcoming L<Activator::Lexicon> module. It
is highly recommended that you read
L<http://search.cpan.org/dist/Locale-Maketext/lib/Locale/Maketext/TPJ13.pod>
before making a decision as to which localization method your
lib/Activator/Dictionary.pm view on Meta::CPAN
To create a dictionary file, create a file named C<E<lt>realmE<gt>.dict>
containing key/value pairs separated by whitespace. Keys can have any
non-whitespace character in them. The amount of whitespace between key
and value can be any length and can be tab or space characters (more
specifically, any character that matches C</\s/>). Keys and values must
be on the same line.
For example:
error.bummer A bummer of an error occured
foo-html <p>this is the foo paragraph</p>
welcome_msg Welcome to Activatory::Dictionary!!
answer 42
Empty lines and any line that the first non-whitespace character is
C<#> will be ignored. Leading whitespace for keys will be ignored as
well, so that you can indent however you see fit.
Leading and trailing whitespace are stripped from values. If the value
for some key must begin or end with white space, wrap the value
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
sub full_message {
my $self = shift;
my $msg = $self->description .': ' . $self->error;
my $code = $self->code;
my $extra = $self->extra;
$msg .= " $code" if $code;
$msg .= " $extra" if $extra;
return $msg;
}
# TODO: implement
sub as_xml {}
sub as_json {}
lib/Activator/Log.pm view on Meta::CPAN
the level for the entire process. This is probably fine for cron jobs,
not so good for web processes.
=head2 Additional Functionality provided
The following Log::Log4perl subs you would normally call with
$logger->SUB are supported through a static call:
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
Activator::Log looks in your Registry for a L<Log::Log4perl>
configuration in this heirarchy:
lib/Activator/Log.pm view on Meta::CPAN
}
sub ERROR {
my ( $pkg, $msg, $logger_label ) = @_;
my $self = &new( 'Activator::Log' );
$msg = &_get_static_arg( $pkg, $msg );
my $logger = $self->{DEFAULT_LOGGER};
if ( $logger_label ) {
$logger = Log::Log4perl->get_logger( $logger_label );
}
$logger->error( $msg );
}
sub WARN {
my ( $pkg, $msg, $logger_label ) = @_;
my $self = &new( 'Activator::Log' );
$msg = &_get_static_arg( $pkg, $msg );
my $logger = $self->{DEFAULT_LOGGER};
if ( $logger_label ) {
$logger = Log::Log4perl->get_logger( $logger_label );
}
lib/Activator/Log.pm view on Meta::CPAN
$logger->trace( $msg );
}
}
sub is_fatal {
my $self = &new( 'Activator::Log' );
return $self->{DEFAULT_LOGGER}->is_fatal();
}
sub is_error {
my $self = &new( 'Activator::Log' );
return $self->{DEFAULT_LOGGER}->is_error();
}
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();
lib/Activator/Log.pm view on Meta::CPAN
$self->{DEFAULT_LOGGER}->logwarn( $msg );
}
sub logdie {
my ( $pkg, $msg ) = @_;
my $self = &new( 'Activator::Log' );
$msg = &_get_static_arg( $pkg, $msg );
$self->{DEFAULT_LOGGER}->logdie( $msg );
}
sub error_warn {
my ( $pkg, $msg ) = @_;
my $self = &new( 'Activator::Log' );
$msg = &_get_static_arg( $pkg, $msg );
$self->{DEFAULT_LOGGER}->error_warn( $msg );
}
sub error_die {
my ( $pkg, $msg ) = @_;
my $self = &new( 'Activator::Log' );
$msg = &_get_static_arg( $pkg, $msg );
$self->{DEFAULT_LOGGER}->error_die( $msg );
}
sub logcarp {
my ( $pkg, $msg ) = @_;
my $self = &new( 'Activator::Log' );
$msg = &_get_static_arg( $pkg, $msg );B
$self->{DEFAULT_LOGGER}->logcarp( $msg );
}
sub logcluck {
lib/Activator/Options.pm view on Meta::CPAN
Activator::Options->get_opts( \@ARGV ); # default realm
Activator::Options->get_opts( \@ARGV, $realm );
Strip recognized options from C<@ARGV> and return the configuration
hash C<$opts> for C<$realm> based on C<@ARGV>. C<$realm> is optional
(default is 'default'), and if not specified either the command line
argument (C<--realm>) or environment variable
(C<ACT_OPT_E<lt>realmE<gt>> unless C<ACT_OPT_skip_env> is set) will be
used. Not specifying a realm via one of these mechanisms is a fatal
error.
Examples:
#### get options for default realm
my $opts = Activator::Options->get_opts( \@ARGV );
#### get options for 'some' realm
my $opts = Activator::Options->get_opts( \@ARGV, 'some' );
See L<get_args()> for a description of the way command line arguments
lib/Activator/Pager.pm view on Meta::CPAN
$offset ||= 0;
if( $page_size < 0 ) { $page_size = $set_size }
$self->{offset} = $offset;
$self->{page_size} = $page_size;
$self->{set_size} = $set_size;
$self->{total} = $total;
## error, offset is greater than results?
if( ( $offset >= $total ) || ( $page_size == 0 ) ) {
$self->{from} = 0;
$self->{to} = 0;
$self->{total} = 0;
return $self;
}
## from and to
$self->{from} = $total > 0 ? $offset+1 : 0;
$self->{to} = $offset+$set_size < $total ? $offset+$set_size : $total;
lib/Activator/Registry.pm view on Meta::CPAN
#!/usr/bin/perl
use strict;
use warnings;
use Activator::DB;
Activator::DB->getrow( 'select * from some_table', [], connect->'default');
Run this way:
./test.pl
Produces this error:
activator_db_config missing You must define the key "Activator::DB" or "Activator->DB" in your project configuration
Probably should say something about the fact that you should have run it like this:
ACT_REG_YAML_FILE=/path/to/registry.yml ./test.pl
=item * Utilize other merge methods
lib/Activator/Tutorial.pm view on Meta::CPAN
3. Catalyst is great, Activator tries to fill in some missing parts
=head1 Getting Started: Creating a Catalyst/Activator project
=head1 Databases: ORM or Write SQL? Pagination too!
If you want to always write your own SQL (and sometimes you do), Activator::DB is for you.
=head1 Logging: put it in the right place
=head1 Exceptions: handle program errors with destination aware messaging
=head1 Beyond Catalyst: writing crons and CLI backend apps
=head1 Email: talk to the rest of the world simply
=head1 Appendix A: AJAX Framework
=head1 AUTHOR
lib/Catalyst/Plugin/Activator/Dictionary.pm view on Meta::CPAN
Gets the value for a key (using L<Activator::Dictionary> lookup() sub)
wherever you have access to the catalyst context object C<$c>.
Since L<Activator::Dictionary> provides different realms, we default this plugin to the web realm:
# uses web realm
$c->lookup('dict_key');
However, we can use any other realm we desire:
$c->lookup('dict_key', 'error');
$c->lookup('dict_key', 'other_realm');
=cut
sub lookup {
my ( $c, $key, $realm ) = @_;
$realm ||= 'web';
my $dict = Activator::Dictionary->get_dict( $c->stash->{dict_lang} );
return $dict->lookup( $key, $realm );
};
lib/Catalyst/Plugin/Activator/Exception.pm view on Meta::CPAN
return;
}
sub finalize {
my ($c) = @_;
if ( $c->stash->{e} ) {
## TODO: figure out how to make this work. no level 1-8 makes
## sense from the perspective of the log or the request
#local $Log::Log4perl::caller_depth;
#$Log::Log4perl::caller_depth += 8;
WARN("Execution had error(s)");
foreach my $e ( @{ $c->stash->{e} } ) {
WARN($e);
}
}
delete $c->stash->{e};
return $c->NEXT::finalize(@_);
}
__END__
share/apache2/conf/httpd.conf.tt view on Meta::CPAN
#
#
# Don't give away too much information about all the subcomponents
# we are running. Comment out this line if you don't mind remote sites
# finding out what major optional modules you are running
ServerTokens OS
#
# ServerRoot: The top of the directory tree under which the server's
# configuration, error, and log files are kept.
#
# NOTE! If you intend to place this on an NFS (or otherwise network)
# mounted filesystem then please read the LockFile documentation
# (available at <URL:http://httpd.apache.org/docs/2.2/mod/mpm_common.html#lockfile>);
# you will save yourself a lot of trouble.
#
# Do NOT add a slash at the end of the directory path.
#
ServerRoot "[% apache2.ServerRoot %]"
share/apache2/conf/httpd.conf.tt view on Meta::CPAN
# any <VirtualHost> containers you may define later in the file.
#
# All of these directives may appear inside <VirtualHost> containers,
# in which case these default settings will be overridden for the
# virtual host being defined.
#
#
# ServerAdmin: Your address, where problems with the server should be
# e-mailed. This address appears on some server-generated pages, such
# as error documents. e.g. admin@your-domain.com
#
ServerAdmin root@localhost
#
# ServerName gives the name and port that the server uses to identify itself.
# This can often be determined automatically, but we recommend you specify
# it explicitly to prevent problems during startup.
#
# If this is not set to valid DNS name for your host, server-generated
# redirections will not work. See also the UseCanonicalName directive.
share/apache2/conf/httpd.conf.tt view on Meta::CPAN
#
# EnableSendfile: Control whether the sendfile kernel support is
# used to deliver files (assuming that the OS supports it).
# The default is on; turn this off if you serve from NFS-mounted
# filesystems. Please see
# http://httpd.apache.org/docs/2.2/mod/core.html#enablesendfile
#
#EnableSendfile off
#
# 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/apache2/conf/httpd.conf.tt view on Meta::CPAN
#CustomLog logs/agent_log agent
#
# For a single logfile with access, agent, and referer information
# (Combined Logfile Format), use the following directive:
#
CustomLog logs/access_log combined
#
# Optionally add a line containing the server version and virtual host
# name to server-generated pages (internal error documents, FTP directory
# listings, mod_status and mod_info output etc., but not CGI generated
# documents or custom error documents).
# Set to "EMail" to also include a mailto: link to the ServerAdmin.
# Set to one of: On | Off | EMail
#
ServerSignature On
#
# Aliases: Add here as many aliases as you need (with no limit). The format is
# Alias fakename realname
#
# Note that if you include a trailing / on fakename then the server will
share/apache2/conf/httpd.conf.tt view on Meta::CPAN
#
# Action lets you define media types that will execute a script whenever
# a matching file is called. This eliminates the need for repeated URL
# pathnames for oft-used CGI file processors.
# Format: Action media/type /cgi-script/location
# Format: Action handler-name /cgi-script/location
#
#
# Customizable error responses come in three flavors:
# 1) plain text 2) local redirects 3) external redirects
#
# Some examples:
#ErrorDocument 500 "The server made a boo boo."
#ErrorDocument 404 /missing.html
#ErrorDocument 404 "/cgi-bin/missing_handler.pl"
#ErrorDocument 402 http://www.example.com/subscription_info.html
#
#
# Putting this all together, we can internationalize error responses.
#
# We use Alias to redirect any /error/HTTP_<error>.html.var response to
# our collection of by-error message multi-language collections. We use
# includes to substitute the appropriate text.
#
# You can modify the messages' appearance without changing any of the
# default HTTP_<error>.html.var files by adding the line:
#
# Alias /error/include/ "/your/include/path/"
#
# which allows you to create your own set of files by starting with the
# /var/www/error/include/ files and
# copying them to /your/include/path/, even on a per-VirtualHost basis.
#
Alias /error/ "/var/www/error/"
<IfModule mod_negotiation.c>
<IfModule mod_include.c>
<Directory "/var/www/error">
AllowOverride None
Options IncludesNoExec
AddOutputFilter Includes html
AddHandler type-map var
Order allow,deny
Allow from all
LanguagePriority en es de fr
ForceLanguagePriority Prefer Fallback
</Directory>
# ErrorDocument 400 /error/HTTP_BAD_REQUEST.html.var
# ErrorDocument 401 /error/HTTP_UNAUTHORIZED.html.var
# ErrorDocument 403 /error/HTTP_FORBIDDEN.html.var
# ErrorDocument 404 /error/HTTP_NOT_FOUND.html.var
# ErrorDocument 405 /error/HTTP_METHOD_NOT_ALLOWED.html.var
# ErrorDocument 408 /error/HTTP_REQUEST_TIME_OUT.html.var
# ErrorDocument 410 /error/HTTP_GONE.html.var
# ErrorDocument 411 /error/HTTP_LENGTH_REQUIRED.html.var
# ErrorDocument 412 /error/HTTP_PRECONDITION_FAILED.html.var
# ErrorDocument 413 /error/HTTP_REQUEST_ENTITY_TOO_LARGE.html.var
# ErrorDocument 414 /error/HTTP_REQUEST_URI_TOO_LARGE.html.var
# ErrorDocument 415 /error/HTTP_UNSUPPORTED_MEDIA_TYPE.html.var
# ErrorDocument 500 /error/HTTP_INTERNAL_SERVER_ERROR.html.var
# ErrorDocument 501 /error/HTTP_NOT_IMPLEMENTED.html.var
# ErrorDocument 502 /error/HTTP_BAD_GATEWAY.html.var
# ErrorDocument 503 /error/HTTP_SERVICE_UNAVAILABLE.html.var
# ErrorDocument 506 /error/HTTP_VARIANT_ALSO_VARIES.html.var
</IfModule>
</IfModule>
#
# The following directives modify normal HTTP response behavior to
# handle known problems with browser implementations.
#
BrowserMatch "Mozilla/2" nokeepalive
BrowserMatch "MSIE 4\.0b2;" nokeepalive downgrade-1.0 force-response-1.0
share/apache2/conf/httpd.conf.tt view on Meta::CPAN
#
# VirtualHost example:
# Almost any Apache directive may go into a VirtualHost container.
# The first VirtualHost section is used for requests without a known
# server name.
#
#<VirtualHost *:80>
# ServerAdmin webmaster@dummy-host.example.com
# DocumentRoot /www/docs/dummy-host.example.com
# ServerName dummy-host.example.com
# ErrorLog logs/dummy-host.example.com-error_log
# CustomLog logs/dummy-host.example.com-access_log common
#</VirtualHost>
my $testdb1 = 'test1_mysql';
my $testdb2 = 'test2_mysql';
if ( $ENV{ACT_DB_TEST_ENGINE} eq 'Pg' ) {
Activator::Registry->register('Activator::DB->default->connection', 'test1_pg');
$testdb1 = 'test1_pg';
$testdb2 = 'test2_pg';
}
lives_ok {
$db = Activator::DB->connect('default')
} 'new skool: no connect error on default db';
ok( defined( $db ) && $db->isa('Activator::DB'), 'valid default Activator::DB object');
ok( $db->{cur_alias} eq $testdb1, "alias set to testdb1");
# select default row
lives_ok {
@row = $db->getrow( 'select * from t1' );
} "getrow doesn't die";
ok( $row[0] eq '1' && $row[1] eq 'd1_t1_r1_c1' && $row[2] eq 'd1_t1_r1_c2', 'can select row');
# connnect to alt db
lives_ok {
$db = Activator::DB->connect($testdb2);
} 'no connect error on test2_* db';
ok( defined( $db ) && $db->isa('Activator::DB'), 'valid test2 Activator::DB object');
ok( $db->{cur_alias} eq $testdb2, 'alias set to test2');
# select default row
lives_ok {
@row = $db->getrow( 'select * from t1' );
} "getrow doesn't die";
ok( $row[0] eq '1' && $row[1] eq 'd2_t1_r1_c1' && $row[2] eq 'd2_t1_r1_c2', 'can select row from other db');
# select something that returns nothing, make sure we get empty row(ref) back
ok( @$rowref == 0, 'got empty arrayref when select returns no rows' );
lives_ok {
$rowref = $db->getrow_hashref( "select * from t1 where id = '-42'" );
} "getrow_hashref doesn't die";
ok( keys %$rowref == 0, 'got empty hashref when select returns no rows' );
# go back to default db
lives_ok {
$db->connect();
} 'no connect error';
ok( defined( $db ) && $db->isa('Activator::DB'), 'reverted to valid default Activator::DB object');
ok( $db->{cur_alias} eq $testdb1, "alias reset to $testdb1");
# select default row
lives_ok {
@row = $db->getrow( 'select * from t1' );
} "getrow doesn't die";
ok( $row[0] eq '1' && $row[1] eq 'd1_t1_r1_c1' && $row[2] eq 'd1_t1_r1_c2', 'can select row from orig db');
# select using "change_alias"
t/Dictionary-default.t view on Meta::CPAN
# get the english dictionary while testing for load warnings
my $expected_err1 = q([WARN] dictionary table t2 redefines value for realm 'realmdb2' key_prefix 'k2' column 'c2');
my $expected_err2 = q([WARN] dictionary table t2 redefines value for realm 'realmdb2' key_prefix 'k2' column 'c1');
$capture = IO::Capture::Stderr->new();
$capture->start();
lives_ok {
$dict = Activator::Dictionary->get_dict();
} 'get_dict() does not die';
$capture->stop();
$line = $capture->read;
#ok ( $line =~ /$expected_err1/os, 'got first load error');
ok (defined $line, 'got first expected error');
$line = $capture->read;
#ok ( $line =~ /$expected_err2/os, 'got second load error');
ok (defined $line, 'got second expected error');
$val = $dict->lookup('fkey1');
ok( $val eq 'fvalue1', 'can lookup known key' );
lives_ok {
$val = $dict->lookup('fkey2');
} "lookup doesn't die when looking up invalid key";
ok( !defined($val), 'unknown key returns undef by default' );
$val = $dict->lookup('fkey3');
t/Exception.t view on Meta::CPAN
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' );
};
( run in 0.351 second using v1.01-cache-2.11-cpan-65fba6d93b7 )