# +========================================================================+
# || Copyright (C) 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: $Head URL$
#  Date:     $Date$
#  Source:   $Source$

package CipUX::CAT::Web::Module::ModuleCustody;

use warnings;
use strict;
use CipUX::CAT::Web::Plugin;
use Data::Dumper;
use Log::Log4perl qw(get_logger :levels);
use base qw(CipUX::CAT::Web::Module);
{
    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 $N            => 'module custody';
    Readonly::Scalar my $M            => 'module_custody.cgi';
    Readonly::Scalar my $I            => 'module.png';
    Readonly::Scalar my $T            => 'cipux_task'
        . '_retrieve_all_cat_module'
        . '_name_shortdescription_templatedir'
        . '_author_version_license_isenabled_icon';

    # OBJECT
    my %name_of : ATTR( init_arg => 'name' :default('noname') );

    # METHOD
    sub register {
        my $self = shift;
        my $c    = __PACKAGE__;
        $self->set_module_name_register( { class => $c, name => $M } );
        my $cfg_ar = $self->module_cfg;
        $self->set_module_cfg_register( { cfg_ar => $cfg_ar, name => $M } );
        return 1;
    }

    sub module_cfg : CUMULATIVE(BASE FIRST) {

        my $self   = shift;    # TODO: sometimes not blessed, why?
        my $module = shift;
        my $name   = shift;

        my $desc      = "Manage CAT modules";
        my $ldesc     = "This module can be use to manage CAT modules.";
        my $module_hr = {};
        my @TASK      = ($T);
        $module_hr->{cipuxName}             = $N;
        $module_hr->{cipuxTemplateDir}      = $N;
        $module_hr->{cipuxIcon}             = $I;
        $module_hr->{cipuxDescription}      = $ldesc;
        $module_hr->{cipuxShortDescription} = $desc;
        $module_hr->{cipuxTask}             = \@TASK;

        return [$module_hr];
    }

    sub module {

        my ( $self, $arg_r ) = @_;
        my $rpc
            = ( exists $arg_r->{rpc_obj} )
            ? $arg_r->{rpc_obj}
            : $self->perr('rpc_obj');
        my $cgi
            = ( exists $arg_r->{cgi_obj} )
            ? $arg_r->{cgi_obj}
            : $self->perr('cgi_obj');
        my $lh
            = ( exists $arg_r->{lh_obj} )
            ? $arg_r->{lh_obj}
            : $self->perr('lh_obj');
        my $c_hr
            = ( exists $arg_r->{c_hr} )
            ? $arg_r->{c_hr}
            : $self->perr('c_hr');

        my $l = get_logger(__PACKAGE__);
        my $c_access
            = ( defined $cgi->param('access') )
            ? $cgi->param('access')
            : undef;
        my $c_module
            = ( defined $cgi->param('change') )
            ? $cgi->param('change')
            : undef;

        if ( defined $c_access and defined $c_module ) {
            $l->debug("c_access [$c_access]");
            $l->debug("c_module [$c_module]");
            $self->do_change_access(
                { access => $c_access, module => $c_module, rpc_obj => $rpc }
            );
        }

        # installed stuff
        my $plugin = CipUX::CAT::Web::Module->new();
        $plugin->init();
        my $p_hr = $plugin->get_module_name_register();
        my $o_hr = $plugin->get_module_cfg_register();

        # database stuff
        my $a_hr = $rpc->xmlrpc( { cmd => $T } );
        my $m = 'Can not retrieve module list! ' . $a_hr->{msg};
        return $self->exception( { msg => $m } ) if $a_hr->{status} ne 'TRUE';
        my $r_hr     = $rpc->extract_data_for_tpl( { answer_hr => $a_hr } );
        my $d_ar     = $r_hr->{tpl_data_ar};
        my @tpl_data = ();
        foreach my $hr ( @{$d_ar} ) {    # every reegisterd module
            $l->debug("CN [$hr->{cn}]");

            #$l->debug( 'a_hr: ', { filter => \&Dumper, value => $a_hr } );

            my $o       = $hr->{cn};
            my $data_hr = {

                #  MODULE $o povided by $p_hr->{$o}
                #        task        => $o_hr->{$o}->{cipuxTask},
                name      => $o,
                real_name => $hr->{cipuxName},    # reg name
                icon      => $hr->{cipuxIcon},    # reg icon
                provided_by => ( exists $p_hr->{$o} ) ? $p_hr->{$o} : 'none',
                registered => ( exists $hr->{cn} ) ? 1 : 0,
                catweb => (
                    ( exists $hr->{cn} or exists $p_hr->{$o} )
                        and $hr->{cn} =~ m{\.cgi$}smx
                    )
                ? 1
                : 0,
                installed => ( exists $p_hr->{$o} ) ? 1 : 0,
                enabled => (
                    exists $hr->{cipuxIsEnabled}
                        and $hr->{cipuxIsEnabled} eq 'TRUE'
                    ) ? 1 : 0,
            };
            $p_hr->{$o} = undef;
            push @tpl_data, $data_hr;
        }

        # add non registered stuff
        $l->debug( 'p_hr: ', { filter => \&Dumper, value => $p_hr } );
        $l->debug( 'o_hr: ', { filter => \&Dumper, value => $o_hr } );
        foreach my $o ( %{$p_hr} ) {
            next;    # TODO, remove this an debugging please
            next if not defined $o;
            next if not $o =~ m{\.cgi$}mx;
            my $data_hr = {
                name      => $o,
                real_name => $o_hr->{$o}->{cipuxName},    # fs name
                icon      => $o_hr->{$o}->{cipuxIcon},    # fs icon
                provided_by => ( exists $p_hr->{$o} ) ? $p_hr->{$o} : 'none',
                registered  => 0,
                catweb => ( $o =~ m{\.cgi$}smx ) ? 1 : 0,
                installed => 1,
                enabled   => 0,
            };
            push @tpl_data, $data_hr;

        }

        my $path     = "tpl/$c_hr->{cat_theme}";
        my $style    = $path . '/form.css';
        my $template = $path . '/module_custody/index.html';
        my $layout   = $path . '/module_custody/layout.html';
        return {
            layout    => $layout,
            layout_ar => [
                { begin_html => 1, },
                { body_ar    => [ $lh->maketext('Module Custody') ] },

                {
                    tt2_hr => {
                        tpl      => $template,
                        param_hr => {
                            SHOW_DEBUG => 0,
                            DATA       => \@tpl_data,
                            MODULE     => $name_of{ ident $self},
                            PATH       => $path,
                            lh         => $lh,
                        },

                    }
                },
                {
                    footer_hr =>
                        { show_index_back => 1, show_script_back => 0 },
                },
                { end_html => 1, },
            ],

        };

    }

    sub do_change_access {
        my ( $self, $arg_r ) = @_;
        my $rpc
            = ( exists $arg_r->{rpc_obj} )
            ? $arg_r->{rpc_obj}
            : $self->perr('rpc_obj');
        my $access
            = ( exists $arg_r->{access} )
            ? $arg_r->{access}
            : $self->perr('access');
        my $o
            = ( exists $arg_r->{module} )
            ? $arg_r->{module}
            : $self->perr('module');

        my $l    = get_logger(__PACKAGE__);
        my $c    = 'cipux_task_disable_cat_module';
        my $p_hr = { object => $o, cipuxIsEnabled => 'FALSE' };
        if ($access) {
            $c = 'cipux_task_enable_cat_module';
            $p_hr = { object => $o, cipuxIsEnabled => 'TRUE' };
        }
        $l->debug("cmd [$c]");
        my $a_hr = $rpc->xmlrpc( { cmd => $c, param_hr => $p_hr } );
        my $m = "Can not change access to module [$o]! " . $a_hr->{msg};
        return $self->exception( { msg => $m } ) if $a_hr->{status} ne 'TRUE';

        $c = 'rpc_intern';
        $l->debug("cmd [$c]");
        $p_hr = { subcmd => 'flush', };
        $a_hr = $rpc->xmlrpc( { cmd => $c, param_hr => $p_hr } );
        $m = "Can not flush rbac! " . $a_hr->{msg};
        return $self->exception( { msg => $m } ) if $a_hr->{status} ne 'TRUE';

        return;

    }
}
1;
__END__
