=head1 NAME

Dam::DamLogic

=head1 DESCRIPTION

API for session management and user access control, menu options and reports
layout.

=head1 FUNCTIONS

=cut

use strict;
use warnings;
use utf8;

package Dam::DamLogic;

use Exporter qw(import);
our @EXPORT = qw(
	ALPHA
	BETA

	ACTION_DOWNLOAD
	ACTION_PRINT
	ACTION_SUBMIT
	ACTION_SORT

	CONTROL_CHECK
	CONTROL_DATE
	CONTROL_DATERANGE
	CONTROL_INPUT
	CONTROL_MONTH
	CONTROL_MULTICHECK
	CONTROL_OPTION
	CONTROL_UPLOAD
	CONTROL_YEAR

	PACK_DATEPICKER
	PACK_SELECT
	PACK_TYPEAHEAD

	Show__error_403
	Show__error_500
	Show__about
	Show
	is_report
	is_download

	Component__Header
	Component__Get
	Component__Set

	Session__new
	Session__param
	Session__flush
	Session__close

	User__is_logged_in
	User__access
	User__has_access

	cgiapp_param
	cgiapp_multi
	cgiapp_cookie
	cgiapp_upload
	cgiapp_uploadInfo
	cgiapp_header_add
	cgiapp_header_props

	_t
);
our @EXPORT_OK = qw(
	package_config
	tmpl_load
	tmpl_core
);

use Cwd qw(getcwd);
use CGI::Session;
use Date::Calc qw(Now);
use Module::Load qw(load);

use Dam::Util;
use Dam::Debug;
use Dam::Var;



use constant {
	ALPHA => 'alpha',
	BETA  => 'beta',

	ACTION_DOWNLOAD    => 'Dam::Components::Actions::Download',
	ACTION_PRINT       => 'Dam::Components::Actions::Print',
	ACTION_SUBMIT      => 'Dam::Components::Actions::Run',
	ACTION_SORT        => 'Dam::Components::Actions::Sort',

	CONTROL_CHECK      => 'Dam::Components::Controls::Check',
	CONTROL_DATE       => 'Dam::Components::Controls::Date',
	CONTROL_DATERANGE  => 'Dam::Components::Controls::DateRange',
	CONTROL_INPUT      => 'Dam::Components::Controls::Input',
	CONTROL_MONTH      => 'Dam::Components::Controls::Month',
	CONTROL_MULTICHECK => 'Dam::Components::Controls::MultiCheck',
	CONTROL_OPTION     => 'Dam::Components::Controls::Option',
	CONTROL_UPLOAD     => 'Dam::Components::Controls::Upload',
	CONTROL_YEAR       => 'Dam::Components::Controls::Year',

	PACK_DATEPICKER    => '__DATEPICKER__',
	PACK_SELECT        => '__SELECT__',
	PACK_TYPEAHEAD     => '__TYPEAHEAD__',

	DAM_TEMPLATES      => strval(getcwd(), '/Dam/Components/Templates')
};

my $CURRENT_SESSION = undef;

my %EN_en = (
	LANGUAGE_CODE => undef,
	MONTHS => [ 'January', 'February', 'March', 'April', 'May', 'June', 'July', 'August', 'September', 'October', 'November', 'December' ]
);
my $l10n = \%EN_en;

my @STYLESHEETS = ();
my @JAVASCRIPTS = ();



sub Show__error_403 {
	cgiapp_header_add(
		-status => '401 Forbidden'
	);
	return Show(
		DISPLAY  => 'PAGE',
		TITLE    => _t('Unauthorized Access'),
		TEMPLATE => tmpl_core('Error403',
			APP_NAME                => CONFIG('APP_NAME'),
			T_ATTENTION             => _t('ATTENTION!'),
			T_UNAUTHORIZED_ACCESS   => _t('Unauthorized Access'),
			T_REPORT_WITHOUT_ACCESS => _t('You are trying to run a report without sufficient access privileges.'),
			T_CONTACT_ADMINISTRATOR => _t('Please contact the administrator to resolve it.')
		)
	);
}



sub Show__error_500 {
	return Show(
		DISPLAY  => 'PAGE',
		TITLE    => _t('Unexpected Error'),
		TEMPLATE => tmpl_core('Error500',
			APP_NAME                 => CONFIG('APP_NAME'),
			T_ATTENTION              => _t('ATTENTION!'),
			T_UNEXPECTED_ERROR       => _t('Unexpected Error'),
			T_ERROR_DURING_EXECUTION => _t('An unexpected error occurred during execution.'),
			T_CONTACT_ADMINISTRATOR  => _t('Please contact the administrator to resolve it.')
		)
	);
}



sub Show__about {
	return Show(
		DISPLAY  => 'PAGE',
		TITLE    => _t('About <--app-->', app => CONFIG('APP_NAME')),
		TEMPLATE => tmpl_core('About',
			APP_NAME       => CONFIG('APP_NAME'),
			APP_SLOGAN     => CONFIG('APP_SLOGAN'),
			VERSION        => CONFIG('VERSION'),
			GLOBAL_WARNING => __global_messages('warning'),

			T_VERSION_NEWS => _t('What\'s new'),
			T_VERSION_PREV => _t('Previous version'),

			CHANGELOG_LAST => __changelog(CONFIG('REF_LAST_CHANGELOG')),
			CHANGELOG_PREV => __changelog(CONFIG('REF_PREV_CHANGELOG'))
		)
	);
}



=head2 Show($data_ref)

Returns the complete HTML code to display the report for the current package.

=head3 Arguments:

  - B<$data_ref> (optional): A reference to the data structure that will be
    passed to the template associated with the current package. If no reference
    is indicated then only the report filter will be displayed (usually the
	first time it is run).

=cut

sub Show {
	my %arg = @_;

	check_arguments(\%arg,
		DISPLAY  => [ ARG_DEFAULT, 'REPORT', 'PAGE' ],
		TITLE    => [ ARG_OPTIONAL ],
		DATA_REF => [ ARG_OPTIONAL ],
		TEMPLATE => [ ARG_OPTIONAL ]
	);

	my $title = $arg{TITLE};
	my $content = '';
	my $body_classes = '';

	if (is_eq($arg{DISPLAY}, 'REPORT')) {
		my $CURRENT_PACKAGE = RESERVED('REF_CURRENT_PACKAGE');
		return Show__error_500() if !%$CURRENT_PACKAGE;

		# Report title:
		$title = strval($$CURRENT_PACKAGE{TITLE});

		# Body classes:
		$body_classes = strval('report', !is_empty($$CURRENT_PACKAGE{BODY_CLASSES}) ? strval(' ', $$CURRENT_PACKAGE{BODY_CLASSES}) : '');

		# Filter:
		$content = __tmpl_filter($title, $CURRENT_PACKAGE)->output;

		# Report:
		my $content_report = '';
		if (defined($arg{DATA_REF})) {
			my $tmpl_report = tmpl_load(strval($$CURRENT_PACKAGE{ID}, '/', $$CURRENT_PACKAGE{TEMPLATE}, '.tmpl.html'));
			$tmpl_report->param($arg{DATA_REF});
			$content_report = trim($tmpl_report->output);
			$content_report = strval(
				'<div class="alert alert-warning">', "\n",
				'<strong>', _t('NO DATA!'), '</strong> ', _t('There is no data to apply the selection form filter.'), "\n",
				'<span class="hidden-print">', _t('Check the filter conditions.'), '</span>', "\n",
				'</div>'
			) if is_empty($content_report);
		}
		$content = strval(
			'<form class="form-inline" id="filter" method="post" enctype="multipart/form-data">', "\n",
			$content, "\n",
			$content_report, "\n\n",
			'</form>', "\n"
		);
	}

	# Menu:
	my $tmpl_menu = __tmpl_menu();

	# Debug information:
	my $tmpl_debug = __tmpl_debug();

	# Global stylesheets & javascripts:
	Component__Header(ADD => 'CSS', RESOURCE => '/dam/css/bootstrap.min.css', VERSION => '3.3.7',  PRIORITY => -10);
	Component__Header(ADD => 'JS',  RESOURCE => '/dam/js/jquery.min.js',      VERSION => '1.12.4', PRIORITY => -10);
	Component__Header(ADD => 'JS',  RESOURCE => '/dam/js/bootstrap.min.js',   VERSION => '3.3.7',  PRIORITY => -10);

	return strval(
		# Header:
		__tmpl_header($title, BODY_CLASSES => $body_classes)->output,

		$tmpl_menu->output,

		'<div class="container">', "\n\n",

		$tmpl_debug->output,

		$content,

		defined($arg{TEMPLATE}) ? $arg{TEMPLATE}->output : '',

		'</div>', "\n\n",

		# Footer:
		__tmpl_footer()->output
	);
}



=head2 is_report()

Returns C<TRUE> if the current page is the result of executing a report to
B<display>, and C<FALSE> otherwise.

=cut

sub is_report {
	return numval(cgiapp_param('xt')) == 1 ? TRUE : FALSE;
}



=head2 is_download()

Returns C<TRUE> if the current page is the result of executing a report to
B<download>, and C<FALSE> otherwise.

=cut

sub is_download {
	return numval(cgiapp_param('xt')) == 2 ? TRUE : FALSE;
}



sub Component__Header {
	my %args = @_;

	fatal('Header element ADD is required') if !defined($args{ADD});

	if (is_eq($args{ADD}, 'CSS')) {
		delete($args{ADD});
		if (is_eq($args{RESOURCE}, PACK_DATEPICKER)) {
			__add_stylesheet(RESOURCE => '/dam/css/bootstrap-datepicker3.min.css', VERSION => '1.6.4');
		}
		elsif (is_eq($args{RESOURCE}, PACK_SELECT)) {
			__add_stylesheet(RESOURCE => '/dam/css/bootstrap-select.min.css', VERSION => '1.12.4');
		}
		elsif (is_eq($args{RESOURCE}, PACK_TYPEAHEAD)) {
		}
		else {
			__add_stylesheet(%args);
		}
	}
	elsif (is_eq($args{ADD}, 'JS')) {
		delete($args{ADD});
		if (is_eq($args{RESOURCE}, PACK_DATEPICKER)) {
			__add_javascript(RESOURCE => '/dam/js/bootstrap-datepicker.min.js', VERSION => '1.6.4');
			__add_javascript(RESOURCE => strval('/dam/js/bootstrap-datepicker.', _t('LANGUAGE_CODE'), '.min.js'), VERSION => '1.6.4', CHARSET => 'UTF-8');
		}
		elsif (is_eq($args{RESOURCE}, PACK_SELECT)) {
			__add_javascript(RESOURCE => '/dam/js/bootstrap-select.min.js', VERSION => '1.12.4');
			__add_javascript(RESOURCE => strval('/dam/js/bootstrap-select.', _t('LANGUAGE_CODE'), '.min.js'), VERSION => '1.12.4');
		}
		elsif (is_eq($args{RESOURCE}, PACK_TYPEAHEAD)) {
			__add_javascript(RESOURCE => '/dam/js/typeahead.jquery.min.js', VERSION => '0.11.1');
			__add_javascript(RESOURCE => '/dam/js/handlebars.js');
		}
		else {
			__add_javascript(%args);
		}
	}
	else {
		fatal('Header element ADD "', $args{ADD}, '" is not valid');
	}
}



sub Component__Get {
	my ($type, $id) = @_;

	my @value;
	eval {
		load($type);
		@value = $type->Get($id);

		1;
	} or do {
		my $error = $@;
		fatal($error, "\n", 'Form element "', $type, '" can not be loaded');
	};
	return (scalar @value == 1 ? $value[0] : @value) if @value;
	return undef;
}



sub Component__Set {
	my ($type, $value, $id) = @_;

	eval {
		load($type);
		$type->Set($value, $id);

		1;
	} or do {
		my $error = $@;
		fatal($error, "\n", 'Form element "', $type, '" can not be loaded');
	};
}



=head2 Session__new(%arg)

Returns a reference to the user's session (new or current).

=head3 Arguments:

  - B<$uid> (required): User identifier.
  - B<$firstname> (required): Usually a short name to display on the main menu.
  - B<$name> (required): User full name.
  - B<$access> (required): User access.

=cut

sub Session__new {
	my ($uid, $firstname, $name, $access, %user_params) = @_;

	$CURRENT_SESSION = new CGI::Session('driver:MySQL', undef, { Handle => RESERVED('DBH') });

	# Access groups become individual accesses:
	my $user_access = '1';
	if (!is_empty($access)) {
		my @ACCESS_GROUPS = @{CONFIG('REF_ACCESS_GROUPS')};
		foreach my $access_list (split(',', $access)) {
			foreach my $group (@ACCESS_GROUPS) {
				if (is_eq($access_list, $$group[0])) {
					$access_list = $$group[1];
					last;
				}
			}
			$user_access = strval($user_access, ',', $access_list);
		}
		$user_access = strval_join(',', array_uniq(split(',', $user_access)));
	}
	debug(_t('Original access'), $access);
	debug(_t('Assigned access'), $user_access);

	# The session is created and the individual accesses are assigned:
	$CURRENT_SESSION->param(
		USER_UID       => $uid,
		USER_FIRSTNAME => $firstname,
		USER_NAME      => $name,
		USER_ACCESS    => $user_access,
		DEBUG_MODE     => CONFIG('DEBUG_MODE'),
		GRAPH_COUNT    => 0,
		%user_params
	);

	# Set the session expiration time:
	$CURRENT_SESSION->expire('+1d');

	# Cookie:
	cgiapp_header_add(-cookie => cgiapp_cookie(CGISESSID => $CURRENT_SESSION->id));

#	$CURRENT_SESSION->flush();
}



sub Session__param {
	__session_refresh();
	return $CURRENT_SESSION->param(@_) if defined($CURRENT_SESSION);
}



=head2 Session__flush()

Synchronizes the active session with the one stored in the database.

=cut

sub Session__flush {
	__session_refresh();
	$CURRENT_SESSION->flush() if defined($CURRENT_SESSION);
}



=head2 Session__close()

Close and release the current user session.

=cut

sub Session__close {
	__session_refresh();
	$CURRENT_SESSION->delete() if defined($CURRENT_SESSION);
	$CURRENT_SESSION = undef;
}



=head2 User__is_logged_in()

Returns C<TRUE> if the current user is authenticated (if exists an opened
session), and C<FALSE> otherwise.

=cut

sub User__is_logged_in {
	__session_refresh();
	return defined($CURRENT_SESSION) ? TRUE : FALSE;
}



sub User__access {
	my $user_access = Session__param('USER_ACCESS');
	return !is_empty($user_access) ? split(',', $user_access) : ();
}



=head2 User__has_access($access)

Returns C<TRUE> if the current user has a specific individual access, and
C<FALSE> otherwise.

=head3 Arguments:

  - B<$access> (required): Individual access to check.

=cut

sub User__has_access {
	my @user_access = User__access();
	return in_array(shift, \@user_access);
}



sub cgiapp_param {
	return scalar RESERVED('CGIAPP')->query()->param(@_);
}



sub cgiapp_multi {
	my @multi = ();
	eval {
		@multi = RESERVED('CGIAPP')->query()->multi_param(@_);

		1;
	} or do {
		@multi = RESERVED('CGIAPP')->query()->param(@_);
	};
	return @multi;
}



sub cgiapp_cookie {
	return RESERVED('CGIAPP')->query()->cookie(@_);
}



sub cgiapp_upload {
	return RESERVED('CGIAPP')->query()->upload(@_);
}



sub cgiapp_uploadInfo {
	return RESERVED('CGIAPP')->query()->uploadInfo(@_);
}



sub cgiapp_header_add {
	return RESERVED('CGIAPP')->header_add(@_);
}



sub cgiapp_header_props {
	return RESERVED('CGIAPP')->header_props(@_);
}



sub _t {
	if (!defined($$l10n{LANGUAGE_CODE})) {
		eval {
			$$l10n{LANGUAGE_CODE} = 'en';
			return 1 if is_eq(CONFIG('l10n'), 'EN_en');

			my $Translations = strval('Dam::Components::Translations::', CONFIG('l10n'));
			load($Translations);
			$l10n = $Translations->Get();

			1;
		} or do {
			my $error = $@;
			warning($error, "\n", 'Translation messages file "', CONFIG('l10n'), '" not found');
		};
	}

	my $message = shift;

	return $$l10n{LANGUAGE_CODE} if is_eq($message, 'LANGUAGE_CODE');

	if (is_eq($message, 'MONTHS')) {
		my $month = shift;
		return $$l10n{MONTHS} if !defined($month);
		if (is_num($month)) {
			return undef if $month < 1 || $month > 12;
			return $$l10n{MONTHS}[$month - 1];
		}
		else {
			my $m = index_in_array($month, $$l10n{MONTHS});
			return undef if $m == -1;
			return $m + 1;
		}
	}

	$message = $$l10n{$message} if exists($$l10n{$message});
	my %placeholder = @_;
	if (%placeholder) {
		$message =~ s/<--(.*?)-->/$placeholder{"\L$1"}/g;
	}
	return $message;
}



sub package_config {
	my $config_ref = shift;

	my %config = %$config_ref;

	$config{RUN} = 'Run' if !defined($config{RUN});
	$config{RUN_MODE} = strval_trio($config{PACKAGE}, '::', $config{RUN});
	$config{ENABLED} = 1 if !defined($config{ENABLED});

	$config{ACCESS} = () if !defined($config{ACCESS});
	push(@{$config{ACCESS}}, 0);

	return %config if !defined($config{PACKAGE});

	eval {
		load($config{PACKAGE});
		my %package_config = $config{PACKAGE}->Config();

		check_arguments(\%package_config,
			ICON         => [ ARG_OPTIONAL ],
			TEXT         => [ ARG_OPTIONAL ],
			TITLE        => [ ARG_OPTIONAL ],
			DESCRIPTION  => [ ARG_OPTIONAL ],
			NOTES        => [ ARG_OPTIONAL ],
			TOOLTIP      => [ ARG_OPTIONAL ],
			TEMPLATE     => [ ARG_OPTIONAL ],
			STATUS       => [ ARG_OPTIONAL ],
			BODY_CLASSES => [ ARG_OPTIONAL ],

			FILTER_PACKAGE => [ ARG_DEFAULT, $config{PACKAGE} ],
			FILTER_METHOD  => [ ARG_DEFAULT, 'Filter' ]
		);

		$config{ICON}           = $package_config{ICON}           if is_empty($config{ICON});
		$config{TEXT}           = $package_config{TEXT}           if is_empty($config{TEXT});
		$config{TITLE}          = $package_config{TITLE}          if is_empty($config{TITLE});
		$config{DESCRIPTION}    = $package_config{DESCRIPTION}    if is_empty($config{DESCRIPTION});
		$config{NOTES}          = $package_config{NOTES}          if is_empty($config{NOTES});
		$config{TOOLTIP}        = $package_config{TOOLTIP}        if is_empty($config{TOOLTIP});
		$config{TEMPLATE}       = $package_config{TEMPLATE}       if is_empty($config{TEMPLATE});
		$config{STATUS}         = $package_config{STATUS}         if is_empty($config{STATUS});
		$config{BODY_CLASSES}   = $package_config{BODY_CLASSES}   if is_empty($config{BODY_CLASSES});
		$config{FILTER_PACKAGE} = $package_config{FILTER_PACKAGE} if is_empty($config{FILTER_PACKAGE});
		$config{FILTER_METHOD}  = $package_config{FILTER_METHOD}  if is_empty($config{FILTER_METHOD});

		1;
	} or do {
		my $error = $@;
		warning($error, "\n", 'Package "', $config{PACKAGE}, '" can not be loaded');
	};

	return %config;
}



sub tmpl_load {
	return RESERVED('CGIAPP')->load_tmpl(@_);
}



sub tmpl_core {
	RESERVED('CGIAPP')->tmpl_path(DAM_TEMPLATES);
	my $tmpl = tmpl_load(strval(shift, '.tmpl.html'));
	$tmpl->param(@_);
	RESERVED('CGIAPP')->tmpl_path(CONFIG('DIR_TEMPLATES'));
	return $tmpl;
}


# PRIVATE FUNCTIONS:


sub __add_stylesheet {
	my %stylesheet = @_;

	check_arguments(\%stylesheet,
		ROOT_WWW => [ ARG_DEFAULT, CONFIG('ROOT_WWW') ],
		RESOURCE => [ ARG_REQUIRED ],
		VERSION  => [ ARG_OPTIONAL ],
		PRIORITY => [ ARG_DEFAULT, 0 ]
	);
	foreach my $css (@STYLESHEETS) {
		return if is_eq($$css{RESOURCE}, $stylesheet{RESOURCE});
	}
	$stylesheet{DEBUG_MODE} = CONFIG('DEBUG_MODE');
	push(@STYLESHEETS, \%stylesheet);
}



sub __add_javascript {
	my %javascript = @_;

	check_arguments(\%javascript,
		ROOT_WWW => [ ARG_DEFAULT, CONFIG('ROOT_WWW') ],
		RESOURCE => [ ARG_REQUIRED ],
		VERSION  => [ ARG_OPTIONAL ],
		CHARSET  => [ ARG_OPTIONAL ],
		PRIORITY => [ ARG_DEFAULT, 0 ]
	);
	foreach my $js (@JAVASCRIPTS) {
		return if is_eq($$js{RESOURCE}, $javascript{RESOURCE});
	}
	$javascript{DEBUG_MODE} = CONFIG('DEBUG_MODE');
	push(@JAVASCRIPTS, \%javascript);
}



sub __tmpl_header {
	my ($title, %param) = @_;

	$title = defined($title) ? strval(CONFIG('APP_NAME'), ' | ', $title) : CONFIG('APP_NAME');

	# Common stylesheets & javascripts:
	Component__Header(ADD => 'CSS', RESOURCE => '/dam/css/stylesheet.css', VERSION => '0.270' );
	Component__Header(ADD => 'CSS', RESOURCE => '/dam/css/reports.css',    VERSION => '0.191' );
	RESERVED('CGIAPP')->pre__load_stylesheets();

	Component__Header(ADD => 'JS',  RESOURCE => '/dam/js/javascript.js',   VERSION => '0.120' );
	RESERVED('CGIAPP')->pre__load_javascripts();

	my @CSS = sort { $$a{PRIORITY} <=> $$b{PRIORITY} } @STYLESHEETS;
	my @JS  = sort { $$a{PRIORITY} <=> $$b{PRIORITY} } @JAVASCRIPTS;

	return tmpl_core('Header',
		LANGUAGE_CODE => _t('LANGUAGE_CODE'),
		ROOT_WWW      => CONFIG('ROOT_WWW'),
		TITLE         => $title,
		GLOBAL_ERROR  => __global_messages('fatal'),
		STYLESHEETS   => \@CSS,
		JAVASCRIPTS   => \@JS,
		CHECK_BROWSER => !User__is_logged_in(),

		%param
	);
}



sub __tmpl_menu {
	# Menu stylesheets & javascripts:
	Component__Header(ADD => 'CSS', RESOURCE => '/dam/css/jquery.smartmenus.bootstrap.css',   VERSION => '1.10'  );
	Component__Header(ADD => 'JS',  RESOURCE => '/dam/js/jquery.smartmenus.min.js',           VERSION => '1.10'  );
	Component__Header(ADD => 'JS',  RESOURCE => '/dam/js/jquery.smartmenus.bootstrap.min.js', VERSION => '0.4.1' );

	my $tmpl_menu = tmpl_core('Menu');

	return $tmpl_menu if !User__is_logged_in();

	my @user_access = User__access();

	my $main_menu = Session__param('CACHE_MENU');
	if (is_empty($main_menu)) {
		# Main menu:
		my %ROUTES = %{CONFIG('REF_ROUTES')};
		foreach my $menu (sort keys(%ROUTES)) {
			my $submenu = __submenu(\%{$ROUTES{$menu}{OPTIONS}}, \@user_access);
			if (!is_empty($submenu)) {
				$main_menu = strval($main_menu,
					'<li>', "\n",
					'<a href="#" class="dropdown-toogle" data-toggle="dropdown">', $ROUTES{$menu}{TEXT}, ' <span class="caret"></span></a>', "\n",
					'<ul class="dropdown-menu">', "\n", $submenu, '</ul>', "\n",
					'</li>', "\n"
				);
			}
		}
		$main_menu = strval('<ul class="nav navbar-nav" data-sm-options="{showOnClick:true,noMouseOver:true}">', "\n", $main_menu, '</ul>', "\n") if !is_empty($main_menu);

		# User menu:
		my %USER_MENU = %{CONFIG('REF_USER_MENU')};
		my $submenu = __submenu(\%{$USER_MENU{OPTIONS}}, \@user_access);
		if (!is_empty($submenu)) {
			$main_menu = strval($main_menu,
				'<ul class="nav navbar-nav navbar-right" data-sm-options="{showOnClick:true,noMouseOver:true}">', "\n",
				'<li>', "\n",
				'<a href="#" class="dropdown-toogle" data-toggle="dropdown">', Session__param('USER_FIRSTNAME'), ' <span class="caret"></span></a>', "\n",
				'<ul class="dropdown-menu">', "\n", $submenu, '</ul>', "\n",
				'</li>', "\n",
				'</ul>', "\n"
			);
		}

		$main_menu = strval('<div class="collapse navbar-collapse">', "\n", $main_menu, '</div>') if !is_empty($main_menu);
		Session__param('CACHE_MENU' => $main_menu);
	}

	$tmpl_menu->param(
		APP_NAME  => CONFIG('APP_NAME'),
		APP_MNEMO => CONFIG('APP_MNEMO'),

		ROUTES => $main_menu,

		T_NAVIGATION => _t('Navigation')
	);
	return $tmpl_menu;
}



sub __submenu {
	my ($options_ref, $user_access_ref) = @_;

	my $submenu = '';
	my $divider = 0;
	foreach my $option (sort keys(%$options_ref)) {
		if (!is_eq(ref($$options_ref{$option}), 'HASH') && is_eq($$options_ref{$option}, _DIVIDER_)) {
			$divider = 1 if !is_empty($submenu);
			next;
		}
		if (defined($$options_ref{$option}{OPTIONS})) {
			my $sublevel = __submenu(\%{$$options_ref{$option}{OPTIONS}}, $user_access_ref);
			next if is_empty($sublevel);
			my $icon = strval(' <span class="glyphicon glyphicon-', $$options_ref{$option}{ICON}, '"></span>') if !is_empty($$options_ref{$option}{ICON});
			$submenu = strval($submenu,
				$divider ? strval('<li class="divider"></li>', "\n") : '',
				'<li>', "\n",
				'<a href="#" class="dropdown-toggle" data-toggle="dropdown">', $$options_ref{$option}{TEXT}, $icon, ' <span class="caret caret-right"></span></a>', "\n",
				'<ul class="dropdown-menu">', $sublevel, '</ul>', "\n",
				'</li>', "\n"
			);
			$divider = 0;
		}
		else {
			my %option = package_config(\%{$$options_ref{$option}});
			next if is_empty($option{TEXT});
			next if !match_arrays($user_access_ref, $option{ACCESS});
			my $icon = strval(' <span class="glyphicon glyphicon-', $option{ICON}, '"></span>') if !is_empty($option{ICON});
			$submenu = strval($submenu,
				$divider ? strval('<li class="divider"></li>', "\n") : '',
				$option{ENABLED} && defined($option{RUN_MODE}) ? '<li>' : '<li class="disabled">',
				$option{ENABLED} && defined($option{RUN_MODE}) ? strval('<a href="#" class="option" id="', $option{RUN_MODE}, '"') : '<a href="#"',
				defined($option{TOOLTIP}) ? strval(' data-toggle="tooltip" data-placement="auto right" title="', _t($option{TOOLTIP}), '">') : '>',
				_t($option{TEXT}), !is_empty($option{STATUS}) ? strval('&nbsp;<sup class="', $option{STATUS}, '">', _t($option{STATUS}), '</sup>') : '', $icon,
				'</a></li>', "\n"
			);
			$divider = 0;
		}
	}
	return $submenu;
}



sub __tmpl_filter {
	my ($title, $option_ref) = @_;

	# Filter javascripts:
	Component__Header(ADD => 'JS', RESOURCE => '/dam/js/jquery.validate.min.js',    VERSION => '1.15.0');
	Component__Header(ADD => 'JS', RESOURCE => '/dam/js/jquery.validate.es.min.js', VERSION => '1.15.0');

	my %option = %$option_ref;

	my $tmpl_filter = tmpl_core('Filter');

	my @filter_info = ();
	my @filter_controls = ();
	my @filter_actions = ();
	my @filter_js = ();


	my %filter = ();
	my $filter_package = $option{FILTER_PACKAGE};
	my $filter_method = $option{FILTER_METHOD};
	eval {
		load($filter_package);
		%filter = $filter_package->$filter_method();

		1;
	} or do {
		my $error = $@;
		fatal($error, 'Module "', $filter_package, '" cannot be loaded');
	};

	my @IDs = ();
	if (defined($filter{CONTROLS})) {
		foreach my $control (sort keys(%{$filter{CONTROLS}})) {
			eval {
				load($filter{CONTROLS}{$control}{TYPE});
				push(@filter_controls, { CONTROL => strval($filter{CONTROLS}{$control}{TYPE}->Control__html(\%{$filter{CONTROLS}{$control}}, \@filter_info)) });
				push(@filter_js, { JAVASCRIPT => strval($filter{CONTROLS}{$control}{TYPE}->Control__js(\%{$filter{CONTROLS}{$control}})) });

				my $id = $filter{CONTROLS}{$control}{ID};
				fatal('Form element ID is required') if is_empty($id);
				fatal('Element "', $id, '" already exists in form.') if in_array($id, @IDs);
				push(@IDs, $id);

				1;
			} or do {
				my $error = $@;
				fatal($error, 'Control "', $filter{CONTROLS}{$control}{TYPE}, '" cannot be created');
			};
		}
	}
	if (defined($filter{ACTIONS})) {
		foreach my $action (sort keys(%{$filter{ACTIONS}})) {
			eval {
				load($filter{ACTIONS}{$action}{TYPE});
				push(@filter_actions, { ACTION => $filter{ACTIONS}{$action}{TYPE}->Action__html(\%{$filter{ACTIONS}{$action}}, \@filter_info) });
				push(@filter_js, { JAVASCRIPT => $filter{ACTIONS}{$action}{TYPE}->Action__js(\%{$filter{ACTIONS}{$action}}) });

				my $id = $filter{ACTIONS}{$action}{ID};
				fatal('Form element ID is required') if is_empty($id);
				fatal('Element "', $id, '" already exists in form.') if in_array($id, @IDs);
				push(@IDs, $id);

				1;
			} or do {
				my $error = $@;
				fatal($error, 'Action "', $filter{ACTIONS}{$action}{TYPE}, '" cannot be created');
			};
		}
	}


	my $filter_title = strval('<span class="glyphicon glyphicon-', defined($option{ICON}) ? $option{ICON} : 'file', '"></span> ');
	$filter_title .= defined($option{TITLE}) ? $option{TITLE} : 'FILTRO DE SELECCIÓN';

	my $sup_alpha = strval(' <sup class="alpha"><strong>', _t('alpha'), '</strong></sup>');
	my $sup_beta = strval(' <sup class="beta"><strong>', _t('beta'), '</strong></sup>');

	if (!is_report()) {
		foreach my $note (array($option{NOTES})) {
			report_info($note);
		}
		report_info(_t('Reports in <--alpha--> status are under development and may show errors or not give the expected results.', alpha => $sup_alpha)) if is_eq($option{STATUS}, ALPHA);
		report_info(_t('Reports in <--beta--> status are in validation process.', beta => $sup_beta)) if is_eq($option{STATUS}, BETA);
		report_info(_t('Filter fields marked with <--required--> are required.', required => '<label class="required"></label>'));
	}

	my @now = Now();
	my $now = strval(sprintf ("%02d", $now[0]), ':', sprintf ("%02d", $now[1]));

	$tmpl_filter->param(
		FIRSTTIME       => 1,
		FILTER_TITLE    => strval($filter_title, is_eq($option{STATUS}, ALPHA) ? $sup_alpha : is_eq($option{STATUS}, BETA) ? $sup_beta : ''),
		DESCRIPTION     => $option{DESCRIPTION},
		RUN_MODE        => $option{RUN_MODE},
		FILTER_CONTROLS => \@filter_controls,
		FILTER_ACTIONS  => \@filter_actions,
		FILTER_JS       => \@filter_js,

		APP_NAME        => CONFIG('APP_NAME'),
		REPORT          => $title,
		USER            => Session__param('USER_NAME'),
		TODAY           => strval(format_date_dmy(strval_join('-', get_today_ymd())), ' a las ', $now),
		FILTER_OPTIONS  => \@filter_info,

		T_REPORT        => _t('Report'),
		T_DESCRIPTION   => _t('Description'),
		T_EDITION_DATE  => _t('Edition date'),
		T_REQUESTED_BY  => _t('Requested by'),
		T_WATCH_OUT     => _t('WATCH OUT!'),
		T_CLOSE         => _t('Close'),
	);

	# Error messages, warnings and information:
	__filter_messages(TMPL_FILTER => $tmpl_filter, MESSAGES => 'ERROR');
	__filter_messages(TMPL_FILTER => $tmpl_filter, MESSAGES => 'WARNING');
	__filter_messages(TMPL_FILTER => $tmpl_filter, MESSAGES => 'INFO');

	return $tmpl_filter;
}



sub __filter_messages {
	my %arg = @_;

	check_arguments(\%arg,
		TMPL_FILTER  => [ ARG_REQUIRED ],
		MESSAGES     => [ ARG_REQUIRED, 'ERROR', 'WARNING', 'INFO' ]
	);

	my $REPORT_MESSAGES = strval('REPORT_', $arg{MESSAGES});
	my $MESSAGES = RESERVED(strval('REF_', $REPORT_MESSAGES));
	$arg{TMPL_FILTER}->param($REPORT_MESSAGES => strval(
		!is_eq($arg{MESSAGES}, 'INFO') ? strval('<strong>', _t(strval($arg{MESSAGES}, scalar @$MESSAGES > 1 ? 'S!' : '!')), '</strong> ') : '',
		scalar @$MESSAGES == 1 ? $$MESSAGES[0] : strval('<ul>', "\n", '<li>', strval_join(strval('</li>', "\n", '<li>'), @$MESSAGES), '</li>', '</ul>', "\n")
	)) if @$MESSAGES;
}



sub __tmpl_debug {
	my $debug = strval_join(strval('</li>', "\n", '<li>'), RESERVED('REF_DEBUG_INFO'));
	return tmpl_core('Debug',
		DEBUG => !is_empty($debug) ? strval('<ol>', "\n", '<li>', $debug, '</li>', "\n", '</ol>') : ''
	);
}



sub __tmpl_footer {
	return tmpl_core('Footer',
		DEBUG_MODE       => CONFIG('DEBUG_MODE'),
		FOOTER_COPYRIGHT => CONFIG('FOOTER_COPYRIGHT'),
		TODAY            => format_date_dmy(strval_join('-', get_today_ymd())),
		CHECK_BROWSER    => !User__is_logged_in(),

		T_ATTENTION      => _t('ATTENTION!'),
		T_WARNING_MODE   => _t('You are running <--app--> in <--mode-->.',
			app => strval('<font size="+1" style="font-weight: normal;">', CONFIG('APP_NAME'), '</font>'),
			mode => strval('<font size="+1" style="font-weight: normal;">', CONFIG('DEBUG_MODE') == 1 ? _t('develop mode') : _t('testing mode'), '</font>')
		),
		T_OLD_BROWSER    => _t('This browser is out of date'),
		T_UPDATE_BROWSER => _t('You must update to use <--app--> correctly.', app => strval('<strong>', CONFIG('APP_NAME'), '</strong>')),
		T_UPDATE_NOW     => _t('Update my browser now'),
		T_CLOSE          => _t('Close')
	);
}



sub __global_messages {
	my $type = shift;

	open(my $fh, '<:encoding(UTF-8)', "error_$type.txt") or return '';
	my @warnings = ();
	while (my $row = <$fh>) {
		chomp($row);
		$row = trim($row);
		push(@warnings, $row) if $row && !is_eq(substr($row, 0, 1), '#');
	}
	return '' if scalar @warnings == 0;
	my $warnings = '';
	my $title = is_eq($type, 'fatal') ? '<h4 class="blink">¡Atención!</h4>' : '<h4>Aviso</h4>';
	foreach my $warn (@warnings) { $warnings .= "<li>$warn</li>"; }
	return "<p>$title<ul>$warnings</ul></p>";
}



sub __changelog {
	my $CHANGELOG = shift;

	my @user_access = User__access();
	my @changelog_list = ();
	my $version_block = '';
	my $separe = FALSE;
	foreach my $item (@$CHANGELOG) {
		my ($version, $access, $log) = @$item;
		my @access_to_this_new = split(',', $access) if defined($access);
		if (is_eq($version, '-')) {
			push(@changelog_list, { ITEM => '<li class="divider"></li>' }) if $separe;
			$separe = FALSE;
		}
		elsif (match_arrays(\@user_access, \@access_to_this_new) || in_array('0', \@user_access)) {
			push(@changelog_list, { ITEM => strval(!is_eq($version, $version_block) ? strval('<li class="version"><span>', $version, '</span> ') : '<li>', $log, '</li>') });
			$version_block = $version;
			$separe = TRUE;
		}
	}
	return \@changelog_list;
}



=head2 __session_refresh()

Updates the reference to the user's current session.

=cut

sub __session_refresh {
	if (!defined($CURRENT_SESSION)) {
		my $sid = cgiapp_cookie('CGISESSID') || cgiapp_param('CGISESSID') || undef;
		if (defined($sid)) {
			$CURRENT_SESSION = new CGI::Session('driver:MySQL', $sid, { Handle => RESERVED('DBH') });
#			$CURRENT_SESSION->flush();
			if (defined($CURRENT_SESSION) && !is_eq($sid, $CURRENT_SESSION->id())) {
				$CURRENT_SESSION->delete();
				$CURRENT_SESSION = undef;
			}
		}
	}
}



1;

=head1 AUTHOR

Manuel Cillero C<< <manuel@cillero.es> >>

=head1 COPYRIGHT

The MIT License (MIT)

Copyright (c) 2004-2020 Manuel Cillero. All rights reserved.

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.

=cut