1125 lines
30 KiB
Perl
1125 lines
30 KiB
Perl
=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 @all_access = split(',', $access);
|
|
my @ACCESS_GROUPS = @{CONFIG('REF_ACCESS_GROUPS')};
|
|
foreach my $one_access (@all_access) {
|
|
foreach my $group (@ACCESS_GROUPS) {
|
|
if ($one_access eq $$group[0]) {
|
|
$user_access .= concat(',', $$group[1]);
|
|
last;
|
|
}
|
|
$user_access .= ",$one_access";
|
|
}
|
|
}
|
|
$user_access = 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(' <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
|