File Coverage

erecipes/perl/lib/CGI/Ex/Recipes.pm

Criterion	Covered	Total	%
statement	27	85	31.7
branch	0	34	0.0
condition	0	27	0.0
subroutine	9	27	33.3
pod	18	18	100.0
total	54	191	28.2

package CGI::Ex::Recipes;
use utf8;
use warnings;
use strict;
use Carp qw(croak);
use Data::Dumper;
use base qw(CGI::Ex::App);
use CGI::Ex::Die register => 1;
use CGI::Ex::Dump qw(debug dex_warn ctrace dex_trace);
use CGI::Ex::Recipes::DBIx qw(
    dbh
    sql
    create_tables
    categories
    recipes
);

our $VERSION = '0.08';

sub ext_conf {
    my $self = shift;
    $self->{'ext_conf'} = shift if @_ == 1;
    return $self->{'ext_conf'} || 'conf';
}

#overwritten the new (in 2.18)implementation of 'conf' so
# the application can find its, given  Recipes.conf
sub conf {
    my $self = shift;
    $self->{'conf'} = pop if @_ == 1;
    return $self->{'conf'} ||= do {
    my $conf = $self->conf_obj->read($self->conf_file, {no_warn_on_fail => 1}) || croak $@;
#my $conf = $self->conf_file;
#$conf = ($self->conf_obj->read($conf, {no_warn_on_fail => 1}) || $self->conf_die_on_fail ? croak $@ : {}) if ! $conf;
        my $hash = $self->conf_validation;
        if ($hash && scalar keys %$hash) {
            my $err_obj = $self->val_obj->validate($conf, $hash);
            die $err_obj if $err_obj;
        }
        $conf;
    }
}

sub load_conf { 1 }

sub base_dir_abs {$_[0]->{'base_dir_abs'} || ['./']}

sub allow_morph {
    my ( $self, $step ) = @_;
    return $self->conf->{allow_morph}->{$step};
}

#...but rather override the path_info_map hook for a particular step.
sub path_info_map {
    my ($self) = @_;
    my $step = $self->form->{ $self->step_key } || $self->conf->{default_step};
    return $self->conf->{path_info_map}{$step} || do {
        my $step = $self->form->{ $self->step_key } || $self->conf->{default_step};
        return '' if $step eq $self->conf->{default_step};
        [
            [
                qr{^/$step/(\d+)}, 'id'
            ]
        ];
    }
}

#Will be run natively for all subclasses
sub skip { shift->form->{'id'} ? 0 : 1 }

#ADDING AUTHENTICATION TO THE ENTIRE APPLICATION
sub get_pass_by_user {
    my $self = shift;
    my $user = shift;
    return $self->conf->{users}{$user};
}

#ADDING AUTHENTICATION TO INDIVIDUAL STEPS
sub require_auth {
    my ($self, $step) = @_;
    #allow configuration first
    return $self->conf->{require_auth}{$step} || 0;
}

#get authentication arguments from configuration if there is such
sub auth_args {
    my $self = shift;
    {
        $self->conf->{template_args},
        $self->conf->{auth_args}
    };
}

sub hash_base {
    my $self = shift;
    my $hash = $self->SUPER::hash_base(@_);
    $hash->{'app'} = $self;
    #require Scalar::Util;
    Scalar::Util::weaken($hash->{'app'});
    return $hash;
}


sub post_navigate {
    my $self = shift;
    # show what happened
    if (values %{$self->{'debug'}}) {
        debug $self->dump_history if $self->conf->{debug}{dump_history};
        debug $self->conf if $self->conf->{debug}{conf};
        debug \%ENV if $self->conf->{debug}{ENV};
        debug $self->cookies if $self->conf->{debug}{cookies};
        debug $self->form if $self->conf->{debug}{form};
        debug \%INC if $self->conf->{debug}{INChash};
        debug \@INC if $self->conf->{debug}{INCarray};
        debug $self->{_package} if $self->conf->{debug}{_package};
        debug [sort keys %{$self->{_cache}}] if $self->conf->{debug}{_cache};
    }
    #or do other usefull things.
}

sub pre_navigate {
    #efectively logout
    require CGI::Ex::Auth;
    $_[0]->CGI::Ex::Auth::delete_cookie({'key'=>'cea_user'})
        if $_[0]->form->{'logout'};
    return 0;
}

sub pre_step {
    $_[0]->step_args;
    #run other things here
    return 0;
}

# hook/method - returns parsed arguments from C<$self->form->{step_info}>
#for the curent step
# initially called in pre_step
sub step_args {
    return $_[0]->form->{step_args} || do {
        if($_[0]->form->{step_info}){
            my @step_args = split /\//,$_[0]->form->{step_info};
            for( my $i = 0 ; $i < @step_args; $i = $i+2 ){
                $_[0]->form->{step_args}{$step_args[$i]} = $step_args[$i+1] || '';
            }
        }
        return $_[0]->form->{step_args} || {};
    }
}

#Returns the cache object.
sub cache {
    my $self = shift;
    return $self->{cache} || do {
        require CGI::Ex::Recipes::Cache;
        $self->{cache} = CGI::Ex::Recipes::Cache->new({ cache_hash =>{}, dbh => $self->dbh });
    };
}


#========================== UTIL ==============================
#Utility funcions - may be moved to an Util class if needed
sub strftmime {
    my $self = shift;
    require POSIX;
    POSIX::strftime(shift,localtime( shift||time ) );
}
sub now {time};
1; # End of CGI::Ex::Recipes


__END__