# +========================================================================+
# || Copyright (C) 2009 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::BasicObject;

use warnings;
use strict;
use Data::Dumper;
use Log::Log4perl qw(get_logger :levels);
use base qw(CipUX::CAT::Web::Module);

#use Template;

{

    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 $TEMPLATE     => q{basic_object};
    Readonly::Scalar my $LETTER_START => 'A';
    Readonly::Scalar my $SMALL_LIST   => 15;
    Readonly::Array my @ABC           => ( $LETTER_START .. 'Z' );
    Readonly::Array my @MODULE =>
        qw(admin.cgi class.cgi student.cgi teacher.cgi);

    Readonly::Hash my %ENTITY => (
        'admin'   => 'admin_account',
        'class'   => 'class_share',
        'student' => 'student_account',
        'teacher' => 'teacher_account',
    );

    Readonly::Hash my %MODALITY => (
        'admin'   => 'admin',
        'class'   => 'class',
        'student' => 'student',
        'teacher' => 'teacher',
    );

    Readonly::Hash my %ENTITY_TYPE => (
        'admin'   => 'account',
        'class'   => 'share',
        'student' => 'account',
        'teacher' => 'account',
    );

    # cipux_task_retrieve_all_$cipux_entity_lastname_firstname';
    # firstname and lastname only important for accounts
    # cipux_task_list_' . $cipux_entity . 's';
    Readonly::Hash my %LIST_ALL_TASK => (
        'admin' => 'cipux_task_retrieve_all_admin_account_lastname_firstname',
        'class' => 'cipux_task_list_class_shares',
        'student' =>
            'cipux_task_retrieve_all_student_account_lastname_firstname',
        'teacher' =>
            'cipux_task_retrieve_all_teacher_account_lastname_firstname',
    );
    Readonly::Hash my %ICON => (
        'admin'   => 'admin.png',
        'class'   => 'group.png',
        'student' => 'user.png',
        'teacher' => 'senior.png',
    );

    # OBJECT
    # used in BUILD/new to pass entity from Comtroller.pm
    my %name_of : ATTR( init_arg => 'name' :default('student') );

    #  GLOBAL
    my $task_hr           = {};
    my $cipux_entity      = $EMPTY_STRING;
    my $cipux_entity_type = $EMPTY_STRING;

    # letter of the shown object
    my $letter_shown = $LETTER_START;

    # letter of the first found object
    my $letter_first = $LETTER_START;

    #  METHOD
    sub register {

        my $self = shift;

        my $c = __PACKAGE__;    # module class name
        foreach my $m (@MODULE) {
            $self->set_module_name_register( { class => $c, name => $m } );
            $self->task_cfg($m);
            my $c_ar = $self->module_cfg($m);    # ( $self, $m );
            $self->set_module_cfg_register( { cfg_ar => $c_ar, name => $m } );
        }

        return 1;

    }

    sub module_cfg : CUMULATIVE(BASE FIRST) {

        my $self   = shift;
        my $module = shift;

        # somtimes there is no object in self. Probably wrong usage
        # by cipux_cat_web_module client?
        my $name = $self;
        if ( defined $module ) { $name = $module; }
        $name =~ s{\.cgi}{}smx;

        my %desc = ( $name => 'Basic ' . lcfirst $name . ' management' );
        my $d = "This module let you create, destroy, list $name";
        $d .= ' accounts or shares and set passwords.';
        my %ldesc = ( $name => $d );
        my $module_hr = {};
        $module_hr->{cipuxName}        = $name;
        $module_hr->{cipuxTemplateDir} = 'basic_object';
        $module_hr->{cipuxIcon}        = 'basicobject.png';
        if ( $name eq 'teacher' ) {
            $module_hr->{cipuxIcon} = 'senior.png';
        }
        elsif ( $name eq 'admin' ) {
            $module_hr->{cipuxIcon} = 'admin.png';
        }
        elsif ( $name eq 'class' ) {
            $module_hr->{cipuxIcon} = 'group.png';
        }
        $module_hr->{cipuxDescription}      = $ldesc{$name};
        $module_hr->{cipuxShortDescription} = $desc{$name};

        # save all tasks for ACL
        foreach my $t (qw(list create destroy change_password)) {
            if (    defined $name
                and exists $task_hr->{$name}
                and defined $t
                and exists $task_hr->{$name}->{$t} )
            {
                push @{ $module_hr->{cipuxTask} }, $task_hr->{$name}->{$t};
            }
            else {
                push @{ $module_hr->{cipuxTask} }, 'NULL';
            }
        }

        return [$module_hr];
    }

    sub task_cfg {

        my $self   = shift;
        my $module = shift;

        # module_access.cgi => module_access
        $module =~ s{\.cgi}{}smx;

        my $prefix = 'cipux_task_';

        #       = cat_module
        #       = class_share
        $cipux_entity = $ENTITY{$module};

        #            = module
        #            = share
        $cipux_entity_type = $ENTITY_TYPE{$module};

        #     = _class_share
        my $e = '_' . $ENTITY{$module};

        # cipux_task_retrieve_all_student_account_lastname_firstname
        # cipux_task_list_class_shares
        $task_hr->{$module}->{list}    = $LIST_ALL_TASK{$module};
        $task_hr->{$module}->{create}  = $prefix . 'create' . $e;
        $task_hr->{$module}->{destroy} = $prefix . 'destroy' . $e;
        $task_hr->{$module}->{change_password}
            = $prefix . 'change' . $e . '_password';

        return;
    }

    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 $view
            = ( exists $arg_r->{view_obj} )
            ? $arg_r->{view_obj}
            : $self->perr('view_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 $module = $name_of{ ident $self};
        $module =~ s{\.cgi}{}smx;
        $l->debug("module [$module]");

        my $message = $EMPTY_STRING;
        $l->debug('set message to empty');

        # form have to be defined first
        my $form = $self->_form(
            {
                cipux_entity_type => $ENTITY_TYPE{$module},
                page              => 'list',
                mode              => 'list',
                rpc_obj           => $rpc,
                lh_obj            => $lh,
                c_hr              => $c_hr,
                module            => $module,

            }
        );

        # | submitted
        # submitted falues have to be checked second
        $l->debug('evaluate submitted fields ...');
        my $mode
            = ( defined $form->field('mode')
                and scalar $form->field('mode') ne $EMPTY_STRING )
            ? $form->field('mode')
            : 'list';

        $l->debug( 'got mode: ', $mode );

        my $letter = $self->l( $form->field('letter') );
        $l->debug( 'got (shown) letter: ', $letter );

        $letter_shown
            = ( defined $letter and $letter ) ? $letter : $letter_first;
        $l->debug( 'got letter shown: ', $letter_shown );

        $form->field(
            name  => 'letter',
            type  => 'hidden',
            value => "$letter_shown",
            force => 1
        );

        $l->debug('... evaluated submitted fields');
        if ( $form->submitted ) {
            $l->debug('we got something submitted');

            # SET
            if ( $form->submitted eq $lh->maketext('set') ) {
                $l->debug('submitteed value was "set"');
                $l->debug("cipux_entity [$ENTITY{$module}]");

                my $cmd = $task_hr->{$module}->{change_password};
                $l->debug("cmd [$cmd]");

                my $result_hr = $self->set_object_password(
                    {
                        rpc_obj      => $rpc,
                        cgi_obj      => $cgi,
                        form         => $form,
                        cipux_entity => $ENTITY{$module},
                        task         => $cmd,
                    }
                );

            }
            elsif ( $form->submitted eq $lh->maketext('delete') ) {
                $l->debug('submitteed value was "delete"');

                # DESTROY
                my $cmd = $task_hr->{$module}->{destroy};

                my $result_hr = $self->destroy_object(
                    {
                        rpc_obj      => $rpc,
                        cgi_obj      => $cgi,
                        form         => $form,
                        cipux_entity => $ENTITY{$module},
                        task         => $cmd,
                    }
                );

            }

        }

        if ( $form->submitted && $form->validate ) {
            $l->debug('got something submitted and validated');

            # CREATE
            if ( $form->submitted eq $lh->maketext('create') ) {
                $l->debug('submitteed value was "create"');

                $l->debug('create object');

                my $cmd = $task_hr->{$module}->{create};

                my $result_hr = $self->create_object(
                    {
                        rpc_obj      => $rpc,
                        cgi_obj      => $cgi,
                        form         => $form,
                        cipux_entity => $ENTITY{$module},
                        task         => $cmd,
                    }
                );
                $letter_shown
                    = ( exists $result_hr->{letter}
                        and defined $result_hr->{letter} )
                    ? $result_hr->{letter}
                    : $letter_first;

                $l->debug("letter shown [$letter_shown] create call");

            }

        }

        my $task = $LIST_ALL_TASK{$module};
        $l->debug( 'use task: ', $task );

        my $a_hr = $rpc->xmlrpc(
            {
                cmd      => $task_hr->{$module}->{list},
                param_hr => {}
            }
        );
        $l->debug( 'rpc answer_hr ', { filter => \&Dumper, value => $a_hr } );

        # extract data and letters
        my $return_hr = $rpc->extract_data_for_tpl(
            { answer_hr => $a_hr, letter => 1 } );
        my $data_ar        = $return_hr->{tpl_data_ar};
        my $lettercount_hr = $return_hr->{firstletter_hr};
        my $letter_first   = $return_hr->{firstletter};

        $l->debug( 'letter first: ', $letter_first );

        # determine letter to use
        $l->debug( 'old letter shown: ', $letter_shown );
        $letter_shown
            = ( ord $letter_shown < ord $letter_first )
            ? $letter_first
            : $letter_shown;
        $l->debug( 'new letter shown: ', $letter_shown );
        my $use_letter_first
            = ( ord $letter_shown < ord $letter_first ) ? 'TRUE' : 'FALSE';

        # path needed for form and abcnav
        my $path = "tpl/$c_hr->{cat_theme}";
        $l->debug("path [$path]");

        my $object_count = scalar @{$data_ar};
        if ( $object_count > $SMALL_LIST ) {

            # aggregate the link battery
            my @link = ();
            foreach my $l ( sort keys %{$lettercount_hr} ) {
                push @link,
                    "<a class='abcnav' href='cat.cgi?module=$module&letter=$l'>$l</a>";
            }

            # ABC nav
            my $tpl    = Template->new();
            my $output = q{};
            my $t      = $path . '/nav/abcnav.html';
            $l->debug("sub template: [$t]");
            my $out = $tpl->process( $t, { abc => \@link }, \$output )
                || die "Can not process template [$t]!";
            $form->field(
                name  => 'abcnav',
                type  => 'static',
                force => 1,
                value => "$output"
            );
        }
        my @data = ();

        foreach my $d_hr ( @{$data_ar} ) {

            #$l->debug( 'show object: ', $object );
            #next if not $show_object_hr->{$object};
            $d_hr->{'letter'}            = $letter_shown;
            $d_hr->{'LETTER_COUNT'}      = $lettercount_hr;
            $d_hr->{'LETTER_FIRST'}      = $letter_first;
            $d_hr->{'LETTER_SHOWN'}      = $letter_shown;
            $d_hr->{'USE_LETTER_FIRST'}  = $use_letter_first;
            $d_hr->{'CIPUX_ENTITY_TYPE'} = $ENTITY_TYPE{$module};
            $d_hr->{'CIPUX_ENTITY'}      = $ENTITY{$module};        #_account

            if ( $object_count > $SMALL_LIST ) {
                $d_hr->{'SHOW_OBJECT'} = 'FALSE';
            }
            else {
                $d_hr->{'SHOW_OBJECT'} = 'TRUE';

            }

            foreach my $attr (qw(uid cn ou)) {

                # calc first letter of object
                my $fl = $LETTER_START;
                if ( exists $d_hr->{$attr} ) {
                    $fl = uc( substr( $d_hr->{$attr}, 0, 1 ) );
                    $d_hr->{'OBJECT_LETTER_FIRST'} = $fl;
                }

                # if this first letter has to be shown, mark it as such
                if ( exists $d_hr->{$attr}
                    and $fl eq $letter_shown )
                {
                    $d_hr->{'SHOW_OBJECT'} = 'TRUE';
                }
            }
            push @data, $d_hr;
        }

        $form->field( name => 'data', type => 'text', value => \@data );

        $form->field(
            name  => 'name',
            type  => 'static',
            value => $lh->maketext( $ENTITY{$module} ),
            force => 1
        );
        $form->field(
            name  => 'letter',
            type  => 'hidden',
            value => "$letter_shown",
            force => 1
        );
        my $list_body = $form->render();

        # create form
        $l->debug('print object create');
        $form = $self->_form(
            {
                cipux_entity_type => $ENTITY_TYPE{$module},
                page              => 'create',
                mode              => 'create',
                rpc_obj           => $rpc,
                lh_obj            => $lh,
                c_hr              => $c_hr,
                module            => $module,

            }
        );
        $form->field(
            name  => 'id',
            type  => 'text',
            value => $EMPTY_STRING
        );

        $form->field(
            name  => 'letter',
            type  => 'hidden',
            value => "$letter_shown",
            force => 1
        );

        $form->submit( [ $lh->maketext('create') ] );
        $l->debug('print create table');

        #push @page, $form->render();
        my $create_body = $form->render();

        return {

            cookie_hr => {},
            layout    => "$path/basic_object/layout.html",
            layout_ar => [
                { begin_html => 1, },
                {
                    body_ar =>
                        [ $lh->maketext('Basic Object Administration') ]
                },
                { body_ar => [$list_body] },
                { body_ar => [$create_body] },
                {
                    footer_hr =>
                        { show_index_back => 1, show_script_back => 0 },
                },
                { end_html => 1, },
            ],

        };

    }

    sub _form {

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

        my $page
            = (     exists $arg_r->{page}
                and defined $arg_r->{page}
                and $arg_r->{page} )
            ? $self->l( $arg_r->{page} )
            : $self->perr('page');    # curr mode: list, create

        my $mode
            = ( exists $arg_r->{mode} and defined $arg_r->{mode} )
            ? $self->l( $arg_r->{mode} )
            : $self->perr('mode');    # next mode: list, create

        my $module
            = ( exists $arg_r->{module} and defined $arg_r->{module} )
            ? $self->l( $arg_r->{module} )
            : $self->perr('module');
        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__);
        $l->debug( '-> page: ',   $page );
        $l->debug( '-> mode: ',   $mode );
        $l->debug( '-> module: ', $module );

        if ( $mode eq $EMPTY_STRING ) { $mode = 'list'; }
        my $path      = "tpl/$c_hr->{cat_theme}";
        my $style     = "$path/form.css";
        my $tpl       = "$path/basic_object/" . $page . '.html';
        my $module_tr = $module;
        $module_tr =~ s{_}{ }gmx;
        my $form = CGI::FormBuilder->new(
            method => 'post',
            fields => [qw/id password password_repeat mode letter/],

            # validate => {oid => '^[a-z0-9]+$'},
            #  required  => 'oid',
            submit => [ $lh->maketext('set'), $lh->maketext('delete') ],

            #params     => $cgi,
            debug      => 0,
            keepextra  => 1,
            table      => 0,
            reset      => 0,
            sticky     => 0,
            stylesheet => $style,
            template   => {
                type     => 'TT2',
                template => $tpl,
                variable => 'form',
                data     => {
                    MODULE            => $module,
                    MODALITY          => $MODALITY{$module},
                    CIPUX_MODALITY    => $module,
                    CIPUX_MODALITY_TR => $module_tr,
                    SHOW_DEBUG        => 0,
                    TEMPLATE          => $TEMPLATE,
                    ICON              => $ICON{$module},
                    CIPUX_ENTITY_TYPE => $ENTITY_TYPE{$module},
                    CIPUX_ENTITY      => $ENTITY{$module},
                    lh                => $lh,
                },
            },
        );

        $form->field( name => 'mode', type => 'hidden', value => "$mode" );
        $form->field(
            name  => 'module',
            type  => 'hidden',
            value => "$module"
        );

        $form->field( name => 'id', type => 'hidden' );

        $form->field(
            name  => 'password',
            type  => 'password',
            value => $EMPTY_STRING
        );

        $form->field(
            name  => 'password_repeat',
            type  => 'password',
            value => $EMPTY_STRING
        );

        $form->field(
            name  => 'cipuxFirstname',
            type  => 'text',
            value => $EMPTY_STRING
        );

        $form->field(
            name  => 'cipuxLastname',
            type  => 'text',
            value => $EMPTY_STRING
        );

        return $form;

    }

    # TODO: obsolete?
    sub get_entity {

        my ( $self, $arg_r ) = @_;
        my $rpc
            = ( exists $arg_r->{rpc_obj} )
            ? $arg_r->{rpc_obj}
            : $self->perr('rpc_obj');
        my $cmd
            = exists $arg_r->{cmd}
            ? $self->l( $arg_r->{cmd} )
            : $self->perr('cmd');
        my $view
            = exists $arg_r->{view}
            ? $self->l( $arg_r->{view} )
            : $self->perr('view');

        my $l = get_logger(__PACKAGE__);

        my $a_hr = $rpc->xmlrpc( { cmd => $cmd } );

        if ( $a_hr->{status} eq 'FALSE' ) {
            $l->debug('answer is FALSE');
            $l->debug('build exception object');
            $l->debug('return this object');
            return $view->exception(
                { module => 'BasicObject', msg => $a_hr->{msg} } );

        }
        $l->debug('answer is TRUE');

        # Filter all CAT, and use only CAT-Web  ( m{\.cgi$}smx
        my @tpl_data = ();
        my $d_ar = $rpc->extract_data_for_tpl( { answer_hr => $a_hr } );
        foreach my $hr ( @{$d_ar} ) {
            $l->debug("CN [$hr->{cn}]");

            #if ( $hr->{cn} =~ m{\.cgi$}smx ) {
            push @tpl_data, $hr;

            #}
        }

        if ( scalar @tpl_data ) {
            return { success => 1, data_ar => \@tpl_data, };
        }
        else {
            return { success => 0, data_ar => undef, };
        }
    }

}

1;

__END__
