Activator
8 results

 view release on metacpan or  search on metacpan

bin/activator.pl  view on Meta::CPAN 

activator.pl - setup and manage services with an Activator project.

=head1 SYNOPSIS

activator.pl [OPTIONS] ACTION project-name

 Actions
  sync : sync user codebase to target install base

 Options:
  --restart : (re)start the webserver after performing <ACTION>
  --log_level : One of TRACE, DEBUG, INFO, WARN, ERROR, FATAL (see L<Activator::Log>)
  --sync_dir : ignore sync_dir setting from configuration, use this.

 Todo:
  --activator_codebase=<path> : use alternate Activator codebase (for Activator development)

See L<Activator::Tutorial> for a description of how to configure an Activator project.

=cut

bin/activator.pl  view on Meta::CPAN 

$project = $ARGV[-1];

if ( $action eq 'sync' ) {
    &sync( $project );
}
else {
    ERROR("'$action' action not supported");
    exit(1);
}

if ( $config->{restart} ) {
    &restart( $project );
}

sub sync {
    my $project = shift;

    if ( $config->{sync_target} eq '/' ) {
	ERROR( "target sync_dir is root dir! Refusing to continue this DANGEROUS operation");
	exit(1);
    }

bin/activator.pl  view on Meta::CPAN 

		"mkdir -p $config->{sync_conf_dir}",
		"mkdir -p $config->{sync_log_dir}",

		"mkdir -p $perl5lib",
		"mkdir -p $document_root",
		"mkdir -p $server_root/logs",

		# all your perl lib are belong to PERL5LIB
		"rsync -a $rsync_flags $project_codebase/lib/* $perl5lib",

		# symlink template files so we don't have to restart server
		# not that this symlinks INTO document root
		"ln -sf $project_codebase/root $document_root",

		# symlink apache modules
		"ln -sf /usr/lib/httpd/modules $server_root",

		# symlink apache log files
		"ln -sf $server_root/logs $config->{sync_log_dir}/httpd",

	       );

bin/activator.pl  view on Meta::CPAN 

	}

	# 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 {

    my $httpd_conf = $config->{apache2}->{ServerRoot} . '/conf/httpd.conf';
    if ( !-f $httpd_conf ) {
	Activator::Log->logdie( "apache config not found: '$httpd_conf'");
    }

    my $httpd_pid = $config->{apache2}->{PidFile};

    my $cmd;

lib/Activator/DB.pm  view on Meta::CPAN 

	    $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,

lib/Activator/DB.pm  view on Meta::CPAN 


sub getall_hashrefs {
    my ($self, $sql, $bind, $args, $ret) = &_fetch( 'getall_hashrefs', @_);
    return $ret;
}

sub _fetch {
    my ( $fn, $pkg, $sql, $bindref, %args ) = @_;
    my ( $self, $bind, $attr ) = $pkg->_explode( $bindref, \%args );

    $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;
    }

lib/Activator/DB.pm  view on Meta::CPAN 

    }

    return ( $self, $sql, $bind, \%args, $row );
}

sub do_id {
    my ( $pkg, $sql, $bindref, %args ) = @_;
    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 );

lib/Activator/DB.pm  view on Meta::CPAN 

					" 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 );

lib/Activator/DB.pm  view on Meta::CPAN 

    if ( $e ) {
        $e->rethrow;
    }
}

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 );
    }

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 );
##     };

lib/Activator/DB.pm  view on Meta::CPAN 

## =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.
##
## Args:
##   $sql => sql statement
##   $bind => optional bind values arrayref for the sql statement
##   $key_field => column name, column number or arrayref of colunm names/numbers
##                 column number starts at 1
## Returns:
##   a hashref of where each hash entry represents a row of data from the query.
##   The keys for the hash are the values in $key_field.
##   The values in the hash are hashrefs representing the rows in the form
##   returned by fetchrow_hashref.
##   Subsequent rows with the same key will replace previous ones.
##
##   Reference to an empty hash when there is no matching data
##
## Usage example

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/Emailer.pm  view on Meta::CPAN 

Sanity check on the email address. Throws exception on failure.

=cut

sub valid_email {
    my $addr = shift;   

    #characters allowed on name: 0-9a-Z-._ on host: 0-9a-Z-. on between: @
    return 0 if ( $addr !~ /^[0-9a-zA-Z\.\-\_]+\@[0-9a-zA-Z\.\-]+$/ ); 

    #must start or end with alpha or num
    return 0 if ( $addr =~ /^[^0-9a-zA-Z]|[^0-9a-zA-Z]$/); 

    #name must end with alpha or num
    return 0 if ( $addr !~ /([0-9a-zA-Z]{1})\@./ ); 

    #host must start with alpha or num
    return 0 if ( $addr !~ /.\@([0-9a-zA-Z]{1})/ ); 

    #pair .- or -. or -- or .. not allowed
    return 0 if ( $addr =~ /.\.\-.|.\-\..|.\.\..|.\-\-./g ); 

    #pair ._ or -_ or _. or _- or __ not allowed
    return 0 if ( $addr =~ /.\.\_.|.\-\_.|.\_\..|.\_\-.|.\_\_./g ); 

    #host must end with '.' plus 2, 3 or 4 alpha for TopLevelDomain (MUST be modified in future!)
    return 0 if ( $addr !~ /\.([a-zA-Z]{2,4})$/ );

share/apache2/conf/httpd.conf.tt  view on Meta::CPAN 

# 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 %]"

#
# PidFile: The file in which the server should record its process
# identification number when it starts.
#
PidFile [% apache2.PidFile %]

#
# Timeout: The number of seconds before receives and sends time out.
#
Timeout 120

#
# KeepAlive: Whether or not to allow persistent connections (more than

share/apache2/conf/httpd.conf.tt  view on Meta::CPAN 

# KeepAliveTimeout: Number of seconds to wait for the next request from the
# same client on the same connection.
#
KeepAliveTimeout 15

##
## Server-Pool Size Regulation (MPM specific)
## 

# prefork MPM
# StartServers: number of server processes to start
# MinSpareServers: minimum number of server processes which are kept spare
# MaxSpareServers: maximum number of server processes which are kept spare
# ServerLimit: maximum value for MaxClients for the lifetime of the server
# MaxClients: maximum number of server processes allowed to start
# MaxRequestsPerChild: maximum number of requests a server process serves
<IfModule prefork.c>
StartServers       8
MinSpareServers    5
MaxSpareServers   20
ServerLimit      256
MaxClients       256
MaxRequestsPerChild  4000
</IfModule>

# worker MPM
# StartServers: initial number of server processes to start
# MaxClients: maximum number of simultaneous client connections
# MinSpareThreads: minimum number of worker threads which are kept spare
# MaxSpareThreads: maximum number of worker threads which are kept spare
# ThreadsPerChild: constant number of worker threads in each server process
# MaxRequestsPerChild: maximum number of requests a server process serves
<IfModule worker.c>
StartServers         2
MaxClients         150
MinSpareThreads     25
MaxSpareThreads     75

share/apache2/conf/httpd.conf.tt  view on Meta::CPAN 

#
# 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.
#
# If your host doesn't have a registered DNS name, enter its IP address here.
# You will have to access it by its address anyway, and this will make 
# redirections work in a sensible way.
#
ServerName [% apache2.ServerName %]:[% apache2.ListenPort %]

share/apache2/conf/httpd.conf.tt  view on Meta::CPAN 

#
# 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

t/Dictionary-default.t  view on Meta::CPAN 

system( "cat $ENV{PWD}/t/data/Dictionary-create-test.sql | mysql -u root");

# test loading from files. Gotta hack the registry to make this work for testing.
my $config = Activator::Registry->get( 'Activator::Dictionary' );
$config->{dict_files} = "$ENV{PWD}/t/data/Dictionary";

# 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');

t/Dictionary-default.t  view on Meta::CPAN 


$val = $dict->lookup('fkey7');
ok( $val eq 'fvalue 7 has nested "quotes"', 'nested quotes preserved');

# lookups from the db

$val = $dict->lookup('k1.c1', 'realmdb1');
ok( $val eq 'en_t1_c1', 'can fetch en db key' );

$capture = IO::Capture::Stderr->new();
$capture->start();
$dict->get_dict( 'de' );
$capture->stop();
$line = $capture->read;
ok( $line =~ /\[WARN\] Couldn't load dictionary from file for de/, 'missing dict file warns' );
ok( $dict->{cur_lang} eq 'de', 'switching languages works' );

$val = $dict->lookup('k1.c2', 'realmdb1');
ok( $val eq 'de_t2_c2', 'can fetch de db key' );

system( "cat $ENV{PWD}/t/data/Dictionary-drop-test.sql | mysql -u root");

t/Log-default.t  view on Meta::CPAN 

use strict;

use Activator::Log;
use Activator::Registry;
use IO::Capture::Stderr;
use Test::More tests => 18;

Activator::Log::level( 'TRACE' );
my $capture = IO::Capture::Stderr->new();
my $line;
$capture->start();

# tests for all functions :: calls
Activator::Log::TRACE('TRACE');
Activator::Log::DEBUG('DEBUG');
Activator::Log::INFO('INFO');
Activator::Log::WARN('WARN');
Activator::Log::ERROR('ERROR');
Activator::Log::FATAL('FATAL');

# tests for all functions -> calls

t/Log-default.t  view on Meta::CPAN 

    $line = $capture->read;
    ok ( $line =~ /\[$msg\] $msg \(main::/, "$msg works static( :: )" );
}

foreach my $msg ( qw/ TRACE DEBUG INFO WARN ERROR FATAL / ) {
    $line = $capture->read;
    ok ( $line =~ /\[$msg\] $msg \(main::/, "$msg works indirect( -> )" );
}

# test that empty messages are printed properly
$capture->start();
Activator::Log::level('TRACE');
Activator::Log->TRACE('');
Activator::Log->DEBUG('');
Activator::Log->INFO('');
Activator::Log->WARN();
Activator::Log->ERROR();
Activator::Log->FATAL();
$capture->stop();

foreach my $msg ( qw/ TRACE DEBUG INFO WARN ERROR FATAL / ) {

t/Log-disabling.t  view on Meta::CPAN 

}

use Activator::Log;
use IO::Capture::Stderr;
use Test::More tests => 3;

my ( $line, $capture );

Activator::Log::level( 'TRACE' );
$capture = IO::Capture::Stderr->new();
$capture->start();
Activator::Log->TRACE('TRACE');
Activator::Log->DEBUG('DEBUG');
$capture->stop();
$line = $capture->read;
ok ( $line =~ /\[DEBUG\] DEBUG \(main::/, "disable works from script" );

$capture->start();
&Test::outp();
$capture->stop();
$line = $capture->read;
ok ( $line =~ /\[DEBUG\] DEBUG /, "disable works from top level class" );


$capture->start();
&Test::Nested::outp();
$capture->stop();
$line = $capture->read;
ok ( $line =~ /\[DEBUG\] DEBUG /, "disable works from subclass" );

#$capture->start();
#&Test::Nested::outp();
#$capture->stop();
#my $line = $capture->read;
#ok ( $line =~ /\[DEBUG\] DEBUG /, "disable works for subclass trees" );

package Test;
sub outp {
    Activator::Log->TRACE('TRACE');
    Activator::Log->DEBUG('DEBUG');
}

t/Registry-fail.t  view on Meta::CPAN 

#!/usr/bin/perl -w

use Test::More tests => 2;
use Activator::Registry;
use IO::Capture::Stderr;
# bad file warns

my $capture = IO::Capture::Stderr->new();
my $line;
$capture->start();
my $badobj = Activator::Registry->new('foo');
$capture->stop();
$line = $capture->read;
warn $line;
ok( $line =~ /\[WARN\].*foo/, 'bad file warns' );

$badobj->register('key', 'value');
my $val = $badobj->get( 'key' );
ok( $val eq 'value', 'unloaded registry still works to register values');



( run in 0.295 second using v1.01-cache-2.11-cpan-0d8aa00de5b )