Catalyst tricks

Jozef

catalyst logo

Short intro to Catalyst

web request flowchart

$c methods

build-in

$c methods

others come from plugins

What is a $c->view()?

package ViennaPM1::View::Dump;
use base 'Catalyst::View';
use File::Slurp;
sub render {
    my ($self, $c, $dump_name) = @_;
    $dump_name = $c->config->{'View::Dump'}->{'path'}.'/'.$dump_name;
    return read_file($c->path_to($dump_name).'');
}
sub process {
    my ($self, $c) = @_;
    $c->response->content_type('text/plain');
    $c->response->body(
        $self->render($c, $c->stash->{'template'})
    );
    return 1;
}
1;

What is a $c->model()?

package ViennaPM1::Model::Constants;
use base 'Catalyst::Model';
my %constants = ( 'p' => 'perl', 'm' => 'mongers' );
sub named {
    my ($self, $name) = @_;
    die 'no such constatnt' if not exists $constants{$name}; 
    return $constants{$name};
}
sub names {
    return join ', ', keys %constants;
}
1;

What is a $c->controller()?

package ViennaPM1::Controller::Root;
use base 'Catalyst::Controller';
__PACKAGE__->config->{'namespace'} = '';
sub index : Private {
    my ( $self, $c ) = @_;
    $c->stash->{'message'} =
        $c->model('Constants')->names.', generated at: '.$c->time_now;
    $c->stash->{'template'} = 'index.tt2';
    # default view is called to handle the template
}
sub dump : Local {
    my ( $self, $c, $name ) = @_;
    $c->stash->{'template'} = $name;
    $c->forward('View::Dump');
}
1;

What is a plugin after all?

Plugin

package Catalyst::Plugin::TimeNow;
use POSIX 'strftime';
sub setup {
    my $c     = shift;
    $c->log->debug('Now we have: '.time_now($c));
    $c->NEXT::setup( @_ );
}
sub time_now {
    my $c   = shift;
    my $time_format = $c->config->{'TimeNow'}->{'format'} || '%a %b %e %H:%M:%S %Y';
    return strftime $time_format, localtime;
}
1;

the Glue

package ViennaPM1;
use Catalyst::Runtime '5.70';
my @plugins;
BEGIN {
    push(@plugins, '-Debug') if $ENV{'IN_DEBUG_MODE'};
    push(@plugins, qw(
        ConfigLoader
        DefaultEnd	
        Static::Simple
        TimeNow
    ));
}
use Catalyst @plugins;
__PACKAGE__->setup;
1;

Catalyst folder tree

Catalyst customized folder tree

Finally

to display our pages

DBIx::Class

DBIx::Class example

package ViennaPM1::DBIC::Monger;
use base 'DBIx::Class';

__PACKAGE__->load_components(qw{PK::Auto ResultSetManager Core});
__PACKAGE__->table('mongers');
__PACKAGE__->add_columns(qw{
    monger_id
    name
    cpan_id
    status
    life_style_id
});
__PACKAGE__->set_primary_key('monger_id');
__PACKAGE__->sequence('mongers_monger_id_seq');

__PACKAGE__->might_have( 'personal_life' => 'ViennaPM1::PersonalLife', 'monger_id');
__PACKAGE__->has_many  ( 'presentations' => 'ViennaPM1::Presentation', 'monger_id');
__PACKAGE__->belongs_to( 'life_style'    => 'ViennaPM1::LifeStyle',    'life_style_id');

__PACKAGE__->add_unique_constraint(
    uniq_cpan_id => [ qw{cpan_id} ]
);

    # AND CONTINUES ...

DBIx::Class example

sub with_cpan_id : ResultSet {
    my ($self, $cpan_id) = @_;
    return = $self->find({
        cpan_id => $cpan_id
    }, { key  => 'uniq_cpan_id'});
}
sub promote_to_guru {
    my $self = shift;	
    $self->status('GURU');
    $self->update;
}
sub is_active {
    my $self = shift;	
    return 1 if $self->status ne 'DISABLED';
    return 0;
}
1;

What's so great?

For each table

Let's go even further away from Catalyst

pull the trigger, feel the click,
no further danger

Little summary

what we have:

we have the application/tool design before we even started :)

Time for some real tricks

Replace 'please come back later'

two types of errors

$c for scripts

access to $c->controller()

access to $c->model()

$c for scripts

example

how?

authentication with Client Certificates

Why?

Why not?

authentication with Client Certificates

httpd.conf

SSLCertificateKeyFile (...)/ssl/Server.key
SSLCACertificateFile  (...)/ssl/SomeCertificationAuthority.crt
SSLCARevocationFile   (...)/ssl/LatestCRL.pem.crl
<Location /login>
    SSLVerifyClient optional
    SSLVerifyDepth 1
    SSLOptions +StdEnvVars
#   PerlOptions +SetupEnv
</Location>

with "+SetupEnv" catalyst is confused

authentication with Client Certificates

$c->controller('Root')->login()

# need this "hack" to populate env with SSL
# could be done with "PerlOptions +SetupEnv" httpd.conf option but
# that will confuse catalyst and $c->uri_for() will not work properly
$c->apache->subprocess_env if can $c, 'apache';
if ((exists $ENV{'SSL_CLIENT_VERIFY'})
		and ($ENV{'SSL_CLIENT_VERIFY'} eq 'SUCCESS')) {
    $c->stash->{'cert_email'} = $ENV{'SSL_CLIENT_S_DN_Email'};
    $c->stash->{'cert_name'}  = $ENV{'SSL_CLIENT_S_DN_CN'};
    my $autologin_user =
    	$c->default_auth_store->get_user($c->stash->{'cert_email'});
    $c->set_authenticated($autologin_user) if ($autologin_user);
}

Catalyst session bug in Debian Etch

Temporary down

httpd.conf

	Alias /static (...)/root/static
	
	
	<Location />
		SetHandler          modperl
		PerlResponseHandler ViennaPM1
	</Location>

	<Location /static>
		SetHandler default-handler
	</Location>
	
#	RedirectMatch "^/(?!static/)" /static/temp-down-for-maintenance.html

$c->controller('Email')

methods

db history

session_info table

__PACKAGE__->config(
    schema_class => 'ViennaPM1::DBIC',
    connect_info => [
        $config->{'db'}->{'dbi_dsn'},
        $config->{'db'}->{'username'},
        $config->{'db'}->{'password'},
        {
            AutoCommit    => 1,
            on_connect_do => [
                'CREATE TEMPORARY TABLE session_info (modified_by text, session_id text);',
                "INSERT INTO session_info (modified_by, session_id) VALUES ('".basename($0)."', '".$PID."');",
            ],
        },
    ],
);

session_info up-to-date

$c->controller('Root')->auto

if ($c->user_exists) {
    $c->model('DBIC::Session_Info')->modified_by($c->session->{'person'}->{'employeeNumber'});
}
else {
    $c->model('DBIC::Session_Info')->modified_by(undef);
}
$c->model('DBIC::Session_Info')->session_id($c->sessionid);

history_emails_trigger()

CREATE OR REPLACE FUNCTION history_emails_trigger() RETURNS TRIGGER AS $$
DECLARE
    v_modified_by history_emails.created_by%TYPE;
BEGIN
    SELECT modified_by
    INTO v_modified_by
    FROM session_info;
    
    new.created_by := v_modified_by;
    RETURN new;
END;
$$ LANGUAGE plpgsql;

CREATE TABLE history

column changes history

CREATE TABLE history (
    history_id              SERIAL,
    session_id              VARCHAR NOT NULL,
    modified_by             VARCHAR,
    table_name              VARCHAR NOT NULL,
    event                   VARCHAR NOT NULL,
    event_timestamp         TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP,
    comment                 VARCHAR NULL,
    old_values              VARCHAR NULL,
    new_values              VARCHAR NULL,    
    CHECK (event in ('INSERT', 'UPDATE', 'DELETE')),
    CHECK (old_values IS NOT NULL OR new_values IS NOT NULL),
    PRIMARY KEY (history_id)
);

history_trigger()

AFTER INSERT OR UPDATE ON
BEFORE DELETE ON

CREATE OR REPLACE FUNCTION history_trigger() RETURNS TRIGGER AS $$
	#global variables
	my $table_name      = $_TD->{'relname'};
	my $event           = $_TD->{'event'};
#	elog(NOTICE, $event.' '.$table_name);
	my $session_info_query = spi_query(qq{
		SELECT session_id, modified_by
		FROM session_info;
	});	
	my $session_info = spi_fetchrow($session_info_query);
	elog(ERROR, "history_trigger: No session info row") if not defined $session_info;
	my $session_id  = (defined $session_info->{'session_id'}  
		? "'".$session_info->{'session_id'}."'"  : 'NULL');
	my $modified_by = (defined $session_info->{'modified_by'} 
		? "'".$session_info->{'modified_by'}."'" : 'NULL');

history_trigger() purpouse

what we have

we can generate

spi_exec_query()

	my $history_insert = spi_exec_query(qq{
		INSERT INTO history (
			session_id,
			modified_by,
			table_name,
			event,
			comment,
			old_values,
			new_values
		)
		VALUES (
			$session_id,
			$modified_by,
			'$table_name',
			'$event',
			$comment,
			$old_values,
			$new_values
		)
	});

benefits from history

And that's it...

Questions?