/usr/share/perl5/CipUX/CAT/Web/Controller.pm

# +========================================================================+
# || Copyright (C) 2009 - 2010 by Christian Kuelker                       ||
# ||                                                                      ||
# || License: GNU General Public License - GNU GPL - version 2            ||
# ||          or (at your opinion) any later version.                     ||
# +========================================================================+
#  ID:       $Id$
#  Revision: $Revision$
#  Head URL: $HeadURL$
#  Date:     $Date$
#  Source:   $Source$

package CipUX::CAT::Web::Controller;

use 5.008001;
use warnings;
use strict;
use CGI;
use CGI::Carp qw(carpout fatalsToBrowser warningsToBrowser);
use CGI::FormBuilder;
use CipUX::RPC::Client;
use CipUX::CAT::Web::View;
use Class::Std;
use Data::Dumper;
use English qw( -no_match_vars);
use Log::Log4perl qw(get_logger :levels);
use Readonly;
use Template;

use base qw(CipUX CipUX::CAT::Web::L10N);
{

    use version; our $VERSION = qv('3.4.0.3');
    use re 'taint';    # Keep data captured by parens tainted
    delete @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)};    # Make %ENV safer

    # CONST
    Readonly::Scalar my $EMPTY_STRING        => q{};
    Readonly::Scalar my $DEF_LOCALE_MAKETEXT => 'en';

    # OBJECT
    my %module_of :
        ATTR( init_arg => 'module' :get<module> :set<module> :default('CipUX::CAT::Web::Module::Index'));

    # GLOBAL
    my $c_hr   = {};                                  # cookie_hr
    my $cfg_hr = {};                                  # configuration
    my $q      = CGI->new();

    #
    my @page             = ();
    my $letter           = 'A';
    my @c_name           = qw(cat_login cat_session cat_theme cat_locale);
    my $header_cookie_hr = {};
    my $module_hr        = {};
    my $rpc              = undef;

    #   METHODS
    sub get_cgi_obj { return $q; }

    sub set_cfg_hr {
        my ( $self, $arg_r ) = @_;
        $cfg_hr
            = ( exists $arg_r->{cfg_hr} )
            ? $self->h( $arg_r->{cfg_hr} )
            : $self->perr('cfg_hr');
        return;
    }

    sub dispatch {

        my ( $self, $arg_r ) = @_;

        my $l4pcfg
            = ( exists $cfg_hr->{base}->{catweb_l4pconf} )
            ? $self->l( $cfg_hr->{base}->{catweb_l4pconf} )
            : '/usr/share/cipux/etc/cipux-cat-web.log4perl';
        Log::Log4perl::init_once($l4pcfg);
        my $l = get_logger(__PACKAGE__);

        my $module_hr = $self->evaluate($arg_r);

        # throw it out
        $l->debug('throw it out');
        my $result = $self->display( { cgi => $q, module_hr => $module_hr } );

    }

    sub evaluate {

        my ( $self, $arg_r ) = @_;
        my $name = ( exists $arg_r->{name} ) ? $arg_r->{name} : 'index';

        my $l = get_logger(__PACKAGE__);

        my $proto = 'http';
        my $host  = 'localhost';
        my $port  = 8001;
        my $url
            = ( exists $cfg_hr->{base}->{catweb_rpc_server} )
            ? $cfg_hr->{base}->{catweb_rpc_server}
            : $proto . q{://} . $host . q{:} . $port . q{/RPC2};

        $rpc = CipUX::RPC::Client->new(
            {
                url     => $url,
                client  => 'CipUX::CAT::Web',
                version => "$VERSION",
            }
        );

        # Template::Toolkit has a limitation in its WHILE construct. This
        # value will not limit the WHILE loop. This might be needed by some
        # import module
        $Template::Directive::WHILE_MAX = -1;

        # retrieve all cookies and params or set it to defaults or to 'login'
        foreach my $f (@c_name) {
            next if not defined $f;
            $l->debug("process c_name [$f] ...");
            my $p = $q->param($f);
            if ( defined $p ) { $l->debug("param [$p]"); }
            my $c = $q->cookie($f);
            if ( defined $c ) { $l->debug("cookie [$c]"); }
            $c_hr->{$f}
                = ( defined $p and $p ) ? $p
                : ( defined $c and $c ) ? $c
                : ( $f eq 'cat_locale' )
                ? $cfg_hr->{base}->{catweb_login_language}
                : ( $f eq 'cat_theme' ) ? 'default'
                :                         'login';
            $l->debug("result $f [$c_hr->{$f}]");
        }
        $l->debug("got cat_session [$c_hr->{cat_session}]");

        # in the second run the RPC::Client do not have the propper
        # ticket set, we do that now:
        if ( $rpc->get_ticket eq 'rc_dummy' ) {
            $rpc->set_ticket( $c_hr->{cat_session} );
            $l->debug('second run: set ticket!');
        }

        my $pwd
            = (     $q->param('cat_password')
                and $q->param('cat_password') ne $EMPTY_STRING )
            ? $q->param('cat_password')
            : undef;

        # we got a cat_login and a cat_password, we want to authenticate
        if ( $c_hr->{cat_login} ne 'login' and defined $pwd ) {
            $l->debug('we will authenticate');
            $c_hr->{cat_session}
                = $self->authenticate( { password => $pwd } );
            $l->debug("new auth session [$c_hr->{cat_session}]");
        }

        # if we came here from a 2nd run (form submit), we have to
        # find out from which page we came, so that we can adjust the
        # module accordingly
        if ( defined $q->param('module')
            and $q->param('module') ne $EMPTY_STRING )
        {
            $l->debug("adjust module name, old [$name]");
            $name = $q->param('module');
            $name =~ s{\.cgi}{}smx;
            $l->debug("adjust module name, new [$name]");
        }

        # we should get the lang handle now, because we need it
        # either for display a module or dsiplay login view
        my $lh = CipUX::CAT::Web::L10N->get_handle( $c_hr->{cat_locale} );
        $l->debug("setting first lh_obj to [$c_hr->{cat_locale}]");
        $l->debug("lh_obj is [$lh]");

        # if we have no login or a new session we should login
        # if not (we have a login or an old session)
        if (
            not(    $c_hr->{cat_login} ne 'login'
                and defined $c_hr->{cat_session}
                and $c_hr->{cat_session} ne 'login'
                and $c_hr->{cat_session} )
            )
        {

            # we have no login and/or no session, we should log in
            $l->debug("invalid cat_session [$c_hr->{cat_session}]");
            $l->debug("corresp login [$c_hr->{cat_login}]");
            $l->debug("corresp theme [$c_hr->{cat_theme}]");
            $l->debug("corresp locale [$c_hr->{cat_locale}]");
            $l->debug("lh_obj is [$lh]");
            $l->debug('display login screen');

            # display login screen
            my $view = CipUX::CAT::Web::View->new(
                {
                    'cat_login'   => $c_hr->{cat_login},
                    'cat_session' => $c_hr->{cat_session},
                    'cat_locale'  => $c_hr->{cat_locale},
                    'cat_theme'   => $c_hr->{cat_theme},
                }
            );
            $module_hr = $view->login(
                { cgi => $q, cfg_hr => $cfg_hr, lh_obj => $lh } );
            return $module_hr;
        }

        $l->debug("got old cat_session [$c_hr->{cat_session}]");
        $l->debug('we have login and an old session we can module');

        # test the access. (Not really needed, even if you can see the
        # module you will never execute the corresponding tasks to fill the
        # template) Just for convenience.
        my $access = $self->module_access( { module => $name . ".cgi" } );

        # do we have access?
        if ( not $access ) {

            # access denined, wrong login or wrong session
            my $m = "Acesss DENIED to [$name.cgi]";
            $m .= " for [$c_hr->{cat_login}]!";
            $l->info($m);
            my $e = CipUX::CAT::Web::Exception->new(
                {
                    'cat_login'   => $c_hr->{cat_login},
                    'cat_session' => $c_hr->{cat_session},
                    'cat_locale'  => $c_hr->{cat_locale},
                    'cat_theme'   => $c_hr->{cat_theme},
                }
            );
            my $m_hr = $e->exception( { module => 'cat.cgi', msg => $m } );

            return $m_hr;
        }

        # ACCESS OK
        my $info = "ACCESS granted to [$name]";
        $info .= " for [$c_hr->{cat_login}]";
        $l->info($info);
        $l->debug( 'display module ', $module_of{ ident $self} );
        $l->debug("cat_session is OK [$c_hr->{cat_session}]");

        my $mod_access_hr = $self->all_module_access;
        $l->debug( 'mod_access_hr: ',
            { filter => \&Dumper, value => $mod_access_hr } );

        my $view = CipUX::CAT::Web::View->new(
            {
                'cat_login'   => $c_hr->{cat_login},
                'cat_session' => $c_hr->{cat_session},
                'cat_locale'  => $c_hr->{cat_locale},
                'cat_theme'   => $c_hr->{cat_theme},
            }
        );

        # renew session
        $rpc->set_ticket( $c_hr->{cat_session} );
        my $t = $rpc->rpc_session;

        if ( not $t ) {    # then ticket BAD
            my $m = invalid_session_msg($lh);
            $l->info($m);
            my $e = CipUX::CAT::Web::Exception->new(
                {
                    'cat_login'   => $c_hr->{cat_login},
                    'cat_session' => $c_hr->{cat_session},
                    'cat_locale'  => $c_hr->{cat_locale},
                    'cat_theme'   => $c_hr->{cat_theme},
                }
            );
            my $m_hr = $e->exception( { module => 'cat.cgi', msg => $m } );
            return $m_hr;
        }

        # renew session OK, ticket OK
        $rpc->set_ticket($t);
        $c_hr->{cat_session} = $t;

        my $ta = 'cipux_task_retrieve_all_cat_module';
        $ta .= '_name_shortdescription_templatedir_';
        $ta .= 'author_version_license_isenabled_icon';
        my $a_hr = $rpc->xmlrpc( { cmd => $ta } );

        # if no CAT module list
        if ( $a_hr->{status} eq 'FALSE' ) {
            my $m = 'Got no list of CAT modules!';
            $m .= ' Did the administrator forgot to give';
            $m .= ' you access to index.cgi?';
            if (    exists $a_hr->{msg}
                and defined $a_hr->{msg}
                and $a_hr->{msg} )
            {
                $m .= q{ } . $a_hr->{msg};
            }
            my $e = CipUX::CAT::Web::Exception->new(
                {
                    'cat_login'   => $c_hr->{cat_login},
                    'cat_session' => $c_hr->{cat_session},
                    'cat_locale'  => $c_hr->{cat_locale},
                    'cat_theme'   => $c_hr->{cat_theme},
                }
            );
            my $m_hr = $e->exception( { 'module' => 'cat.cgi', msg => $m } );
            return $m_hr;
        }

        # if our module is not enabled
        if (
            not $self->is_module_enabled( { a_hr => $a_hr, module => $name } )
            )
        {
            my $m = "The module $name is not enabled!";
            $m .= ' Did the administrator forgot to enable';
            $m .= ' that module?';
            my $e = CipUX::CAT::Web::Exception->new(
                {
                    'cat_login'   => $c_hr->{cat_login},
                    'cat_session' => $c_hr->{cat_session},
                    'cat_locale'  => $c_hr->{cat_locale},
                    'cat_theme'   => $c_hr->{cat_theme},
                }
            );
            my $m_hr = $e->exception( { 'module' => 'cat.cgi', msg => $m } );
            return $m_hr;
        }

        # display module
        my $v = $module_of{ ident $self}->new( { name => $name } );

        # RUN the CAT module
        my $module_hr = $v->module(
            {
                c_hr          => $c_hr,            # cookies
                cfg_hr        => $cfg_hr,          # config space
                cgi_obj       => $q,               # cgi object
                rpc_obj       => $rpc,             # rpc object
                view_obj      => $view,            # view object
                lh_obj        => $lh,              # i18n object
                mod_access_hr => $mod_access_hr    # mod access info
            }
        );

        return $module_hr;
    }

    sub authenticate {

        my ( $self, $arg_r ) = @_;
        my $p     = $arg_r->{password};
        my $login = $c_hr->{cat_login};

        my $l = get_logger(__PACKAGE__);
        $l->debug('rpc_ping');
        if ( $rpc->rpc_ping() ) {
            $l->debug('rpc_ping SUCCESS');    # SUCCESS
        }
        else {
            $l->debug('rpc_ping FAILURE');    # FAILURE
        }

        $l->debug('rpc_login');
        my $login_ok = $rpc->rpc_login( { login => $login, password => $p } );

        if ($login_ok) {                      # SUCCESS
            $l->debug('rpc_login SUCCESS');
            my $t    = scalar $rpc->get_ticket();
            my $info = "Login OK. Got new ticket [$t] for login [$login]";
            $l->info($info);
            $l->debug("new cat_session via login [$c_hr->{cat_session}]");
            return $t;
        }
        else {                                # FAILURE
            $l->debug(
                "Ctrdummy cat_session via bad login [$c_hr->{cat_session}]");
            $c_hr->{cat_session} = 'login';
            $c_hr->{cat_session} = 'Ctrdummy';
            my $info = 'Login FILAURE.';
            $info .= " Set ticket to [Ctrdummy] for login [login}]";
            $l->info($info);
            $l->debug('rpc_login FAILURE');
        }

        return $c_hr->{cat_session};
    }

    sub get_new_session {

        my ( $self, $arg_r ) = @_;

        my $l = get_logger(__PACKAGE__);
        my $t = $rpc->rpc_session;
        if ($t) {
            $l->debug("got new session [$t]");
            $l->debug("get new cat_session [$c_hr->{cat_session}]");
            return $t;
        }
        else {
            $l->debug("got no new session!");
            $l->debug("get NO new cat_session [$c_hr->{cat_session}]");
            return 0;
        }

        return 0;
    }

    sub all_module_access {

        my ( $self, $arg_r ) = @_;

        my $l = get_logger(__PACKAGE__);
        use CipUX::CAT::Web::Module;
        my $plugin = CipUX::CAT::Web::Module->new();
        $plugin->init();
        $l->debug( "get theme[" . $plugin->get_theme . "]" );
        $plugin->set_theme( $c_hr->{cat_theme} );    # or it will be default
        $l->debug("set theme[$c_hr->{cat_theme}]");

        # simple interface
        my @module = $plugin->get_module_name_register();

        my $r_hr = {};
        foreach my $m (@module) {
            my $access = $self->module_access( { module => $m } );
            $l->debug("module [$m] [$access]");
            $r_hr->{$m} = $access;
        }

        # 'student.cgi' => 0|1
        $l->debug( 'r_hr: ', { filter => \&Dumper, value => $r_hr } );
        return $r_hr;

    }

    sub module_access {

        my ( $self, $arg_r ) = @_;

        my $module
            = ( exists $arg_r->{module} )
            ? $self->l( $arg_r->{module} )
            : $self->perr('module');

        my $l = get_logger(__PACKAGE__);

        # This will be the result by the rpc function
        # '$rpc->rpc_check_access' which will be send
        # to the RPC server:
        # my $param_hr = {
        #    'entity'  => 'cat_module',
        #    'to_ar'   => [$module],            ---> eq $param_ar
        #    'rpcmode' => 'rpc_info',
        #    'from'    => $login,
        #    'subcmd'  => 'cat_module_access',
        #    'scope'   => 'single'
        #  };

        # However, we have just to specify this:
        # subcmd:   user_task_access       | user_task_access_survey       |
        #           user_cat_module_access   | user_cat_module_access_survey |
        #           user_rpc_intern_access | user_rpc_intern_access_survey
        # rpc_mode: rpc_info               | rpc_intern
        # entity:   task                   | rpc_intern      | cat_module
        # scope:    single                 | manifold
        # param_ar: array reference of to be tested modules

        # evtl set_login
        $rpc->set_login( $c_hr->{cat_login} );    # did the client forgot it?
        my ( $from, $access_hr ) = $rpc->rpc_check_access(
            {
                subcmd  => 'cat_module_access',
                rpcmode => 'rpc_info',
                entity  => 'cat_module',
                scope   => 'single',

                #              from               to
                param_ar => [ $c_hr->{cat_login}, $module ],
            }
        );

        # access_hr = {
        #           'frodo' => '1',
        #           'language.cgi' => '0'
        # };
        $l->debug( 'access_hr: ',
            { filter => \&Dumper, value => $access_hr } );
        $l->debug( 'from: ', $from );

        if ( exists $access_hr->{$module} and $access_hr->{$module} ) {
            $l->info("Access GRANTED for [$from] to [$module]");
            return 1;
        }
        $l->info("Access DENIED for [$from] to [$module]");
        return 0;

    }

    sub display {

        my ( $self, $arg_r ) = @_;
        my $module_hr = $arg_r->{module_hr};
        my $q         = $arg_r->{cgi};
        my $caller = exists $arg_r->{caller} ? $arg_r->{caller} : 'unknown';

        my $l    = get_logger(__PACKAGE__);
        my @page = ();

        $l->debug( 'module_hr: ',
            { filter => \&Dumper, value => $module_hr } );
        $l->debug("cat_session [$c_hr->{cat_session}]");

        my $page_ar = $module_hr->{page_ar};    # array ref or empty

        # generate default header cookies
        foreach my $c (@c_name) {
            $header_cookie_hr->{$c}
                = $q->cookie( -name => $c, -value => $c_hr->{$c} );
        }

        # get the cookies for the page if there some
        my $page_cookie_hr
            = ( exists $module_hr->{cookie_hr}
                and ref $module_hr->{cookie_hr} eq 'HASH' )
            ? $module_hr->{cookie_hr}
            : {};

        # cookies from page will overwrite cookies from param or controller
        # cookies this might also add cookies. CAT will do nothing with them
        # at the moment, except to set them in the header. The module has to
        # deal with it, if it wants that
        foreach my $c ( keys %{$page_cookie_hr} ) {
            $header_cookie_hr->{$c} = $q->cookie(
                -name  => $c,
                -value => $page_cookie_hr->{$c}
            );
        }

   # TODO?: write that sub! (this is probabably the best location to execute?)
   # now e to have the session renew in sub session_is_ok
   # get a new session
   # $c_hr->{cat_session} = $self->get_new_session;
        my $css = 'tpl/' . $c_hr->{cat_theme} . '/default.css';

        push @page,
            $q->header(
            -cookie  => [ values %{$header_cookie_hr} ],
            -type    => 'text/html',
            -expires => 'now',
            -charset => 'utf-8',
            );

        #$l->debug(
        #    'standard CGI header: ',
        #    {
        #        filter => \&Dumper,
        #        value  => $q->header(
        #            -cookie  => [ values %{$header_cookie_hr} ],
        #            -type    => 'text/html',
        #            -expires => 'now',
        #            -charset => 'utf-8',
        #        )
        #    }
        #);

        my $page_hr = {};
        my $part    = 0;
        foreach my $v_hr ( @{ $module_hr->{layout_ar} } ) {

            if ( exists $v_hr->{cgi_header} ) {
                $l->debug(
                    'replace standard CGI header with custom: ',
                    { filter => \&Dumper, value => $v_hr->{cgi_header} }
                );

                # replace our CGI header with the header which comes from the
                # module, the module seems to know it better
                shift @page;
                unshift @page, $v_hr->{cgi_header};
            }
            elsif ( exists $v_hr->{begin_html} ) {
                $l->debug('begin_html exists');
                my $lang = $c_hr->{cat_locale};
                $lang =~ s{_}{-}smxg;
                $page_hr->{"part$part"} = $q->start_html(
                    -style    => $css,
                    -lang     => $lang,
                    -encoding => 'utf8',
                    -author   => 'cipux-devel@cipux.org',
                    -title    => $module_of{ ident $self},
                    -meta     => {
                        'keywords' => 'CipUX CAT Web',
                        'copyright' =>
                            'GNU GPL version 2 or any later version',
                    }
                );
                $part++;
            }
            elsif ( exists $v_hr->{page_ar} ) {
                $l->debug('page_ar exists');
                $page_hr->{"part$part"} = join "\n", @{ $v_hr->{page_ar} };
                $part++;
            }
            elsif ( exists $v_hr->{body_ar} ) {
                $l->debug('body_ar exists');
                $page_hr->{"part$part"} = join "\n", @{ $v_hr->{body_ar} };
                $part++;
            }
            elsif ( exists $v_hr->{formbuilder_hr} ) {
                $l->debug('formbuilder_hr exists');
                $page_hr->{"part$part"}
                    = $v_hr->{formbuilder_hr}->{form}->render();
                $part++;
            }
            elsif ( exists $v_hr->{tt2_hr} ) {

                # if the module was not able to set the language and theme,
                # we use this fallback
                if ( not $v_hr->{tt2_hr}->{tpl} =~ m{^tpl/}gmx ) {
                    $v_hr->{tt2_hr}->{tpl}
                        = 'tpl/default/exception/index.html';
                }

                $l->debug('tt2_hr exists');
                my $msg = 'Template process failed for template';
                $msg .= " theme [$header_cookie_hr->{theme}]"
                    if defined $header_cookie_hr->{theme};
                $msg .= " locale [$header_cookie_hr->{locale}]"
                    if defined $header_cookie_hr->{locale};
                my $tpl    = Template->new();
                my $output = q{};
                $l->debug("sub template: [$v_hr->{tt2_hr}->{tpl}]");
                my $out = $tpl->process( $v_hr->{tt2_hr}->{tpl},
                    $v_hr->{tt2_hr}->{param_hr}, \$output )
                    || confess "$msg [$v_hr->{tt2_hr}->{tpl}]! \n"
                    . $tpl->error();
                $page_hr->{"part$part"} = $output;
                $part++;

        # TODO: add teplate var to output if not defined by module:
        #                              #LOGIN      => $login_of{ ident $self},
        #                            #THEME      => $theme_of{ ident $self},
        #                            #LOCALE     => $locale_of{ ident $self},
        #                            MODULE     => $MODULE,
        #                            #SHOW_DEBUG => $debug,
        #                            PATH       => $path,

            }
            elsif ( exists $v_hr->{statusline} ) {
                $l->debug('statusline exists');
                my $view = CipUX::CAT::Web::View->new(
                    {
                        'cat_login'   => $c_hr->{cat_login},
                        'cat_session' => $c_hr->{cat_session},
                        'cat_locale'  => $c_hr->{cat_locale},
                        'cat_theme'   => $c_hr->{cat_theme},
                    }
                );
                $l->debug("statusline object [$view]");

                my $module_hr = $view->status_line(
                    {
                        rpc_obj    => $rpc,
                        cgi        => $q,
                        frommodule => __PACKAGE__,
                    }
                );
                my $tpl    = Template->new();
                my $output = q{};
                my $msg    = 'Template process failed for template';
                foreach my $v_hr ( @{ $module_hr->{layout_ar} } ) {
                    $l->debug(
                        'param_hr [' . $v_hr->{tt2_hr}->{param_hr} . '] ' );
                    foreach
                        my $k ( sort keys %{ $v_hr->{tt2_hr}->{param_hr} } )
                    {
                        $l->debug(
                            "param_hr key [$k] $v_hr->{tt2_hr}->{param_hr}->{$k}"
                        );
                    }
                    my $out = $tpl->process( $v_hr->{tt2_hr}->{tpl},
                        $v_hr->{tt2_hr}->{param_hr}, \$output )
                        || confess "$msg [$v_hr->{tt2_hr}->{tpl}]! \n<br>"
                        . $tpl->error();
                }

                #my $output = $module_hr;

                $l->debug($output);

                $page_hr->{"part$part"} = $output;
                $part++;
            }
            elsif ( exists $v_hr->{footer_hr} ) {
                $l->debug('footer_hr exists');
                my $view = CipUX::CAT::Web::View->new(
                    {
                        'cat_login'   => $c_hr->{cat_login},
                        'cat_session' => $c_hr->{cat_session},
                        'cat_locale'  => $c_hr->{cat_locale},
                        'cat_theme'   => $c_hr->{cat_theme},
                    }
                );

                my $module_hr = $view->footer(
                    {
                        frommodule => __PACKAGE__,
                        rpc_obj    => $rpc,
                        cgi        => $q,
                        show_index_back =>
                            $v_hr->{footer_hr}->{show_index_back},
                        show_script_back =>
                            $v_hr->{footer_hr}->{show_script_back},
                        script_back => $v_hr->{footer_hr}->{script_back},
                    }
                );
                my $tpl    = Template->new();
                my $output = q{};
                my $msg    = 'Template process failed for template';
                foreach my $v_hr ( @{ $module_hr->{layout_ar} } ) {
                    $l->debug(
                        'param_hr [' . $v_hr->{tt2_hr}->{param_hr} . '] ' );
                    foreach
                        my $k ( sort keys %{ $v_hr->{tt2_hr}->{param_hr} } )
                    {
                        $l->debug(
                            "param_hr key [$k] $v_hr->{tt2_hr}->{param_hr}->{$k}"
                        );
                    }
                    my $out = $tpl->process( $v_hr->{tt2_hr}->{tpl},
                        $v_hr->{tt2_hr}->{param_hr}, \$output )
                        || confess "$msg [$v_hr->{tt2_hr}->{tpl}]! \n<br>"
                        . $tpl->error();
                }
                $l->debug($output);
                $page_hr->{"part$part"} = $output;
                $part++;

            }
            elsif ( exists $v_hr->{end_html} ) {
                $l->debug('end_html exists');
                $page_hr->{"part$part"} = $q->end_html;
                $part++;
            }
        }

        my $msg = 'LAYOUT Template process failed!';
        if ( defined $header_cookie_hr->{theme} ) {
            $msg .= " theme [$header_cookie_hr->{theme}]";
        }
        else {
            $msg .= ' No theme cookie.';
        }
        if ( defined $header_cookie_hr->{locale} ) {
            $msg .= " locale [$header_cookie_hr->{locale}]";
        }
        else {
            $msg .= ' No locale cookie.';
        }
        my $tpl    = Template->new();
        my $output = q{};
        $l->debug("arange template: [$module_hr->{layout}]");
        $l->debug("arange template: [$header_cookie_hr->{theme}]");
        $l->debug("arange template: [$c_hr->{cat_theme}]");

        if ( $module_hr->{layout} =~ m{^/} ) {
            $module_hr->{layout}
                = 'tpl/' . $c_hr->{cat_theme} . q{/} . $module_hr->{layout};
        }

        # TODO, use earlier created lh
        my $lh = CipUX::CAT::Web::L10N->get_handle( $c_hr->{cat_locale} );
        $page_hr->{lh} = $lh;
        my $p = Dumper($page_hr);
        my $out = $tpl->process( $module_hr->{layout}, $page_hr, \$output )
            || confess "Process exception FILE [$module_hr->{layout}]"
            . " OUT [$output] PAGE [$p]"
            . " TPL ERROR ["
            . $tpl->error() . "]";

        #    || confess "$msg Regarding template [$module_hr->{layout}]"
        #    ;    #. Dumper($page_hr);

        push @page, $output;

        $l->debug("cat_session [$c_hr->{cat_session}]");
        foreach my $line (@page) {
            print $line or croak 'Can not print page to STDOUT!';
        }

        return $part;
    }

    sub is_module_enabled {

        my ( $self, $arg_r ) = @_;
        my $a_hr
            = ( exists $arg_r->{a_hr} )
            ? $self->h( $arg_r->{a_hr} )
            : $self->perr('a_hr');
        my $module
            = ( exists $arg_r->{module} )
            ? $self->l( $arg_r->{module} )
            : $self->perr('module');

        # find out if the module is enabled
        my $r_hr = $rpc->extract_data_for_tpl( { answer_hr => $a_hr } );
        my $d_ar = $r_hr->{tpl_data_ar};

        foreach my $hr ( @{$d_ar} ) {
            my $m = $hr->{cn};
            next if $m ne "$module.cgi";
            return 1 if $hr->{cipuxIsEnabled} eq 'TRUE';
            return 0 if $hr->{cipuxIsEnabled} eq 'FALSE';
        }
        return 0;
    }

    sub invalid_session_msg {
        my $lh = shift;
        return
             $lh->maketext('The session got invalid. Please login again.');
    }
}

1;

__END__
libcipux-cat-web-perl 3.4.0.3-4.2 / usr / share / perl5 / CipUX / CAT / Web / Controller.pm
