Initial commit
This commit is contained in:
commit
f4bfb0e367
71 changed files with 10399 additions and 0 deletions
299
Dam/Var.pm
Normal file
299
Dam/Var.pm
Normal file
|
|
@ -0,0 +1,299 @@
|
|||
=head1 NAME
|
||||
|
||||
Dam::Var
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
API for global variables.
|
||||
|
||||
=head1 FUNCTIONS
|
||||
|
||||
=cut
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use utf8;
|
||||
|
||||
package Dam::Var;
|
||||
|
||||
use Exporter qw(import);
|
||||
our @EXPORT = qw(
|
||||
UNDEF_VAR
|
||||
DELETE_VAR
|
||||
|
||||
CONFIG
|
||||
GLOBAL
|
||||
RESERVED
|
||||
);
|
||||
|
||||
use constant {
|
||||
UNDEF_VAR => 'K9a(fz=D>vFy3m485jE]:Jm2B@3Ou6',
|
||||
DELETE_VAR => '5s<N0U{R_hNgQn@CyKoD(]rUWO)mbW'
|
||||
};
|
||||
|
||||
use Cwd;
|
||||
|
||||
use Dam::Util;
|
||||
|
||||
|
||||
|
||||
# CONFIGURATION VARIABLES:
|
||||
|
||||
# Today:
|
||||
my ($y, $m, $d) = get_today_ymd();
|
||||
|
||||
# Version news:
|
||||
my @LAST_CHANGELOG = ();
|
||||
my @PREV_CHANGELOG = ();
|
||||
|
||||
# No access groups:
|
||||
my @ACCESS_GROUPS = ();
|
||||
|
||||
# Menus:
|
||||
my %ROUTES = ();
|
||||
my %USER_MENU = (
|
||||
ID => 'Admin',
|
||||
TEXT => 'User',
|
||||
OPTIONS => {
|
||||
M_01 => { RUN => 'RUN_close', ICON => 'off', ACCESS => [ 1 ], TEXT => 'Close session' }
|
||||
}
|
||||
);
|
||||
|
||||
|
||||
my %CONFIG_VARS = (
|
||||
|
||||
# DEBUG MODE (0 = PRODUCTION, 1 = DEVELOPMENT, 2 = TESTING):
|
||||
|
||||
DEBUG_MODE => 1,
|
||||
|
||||
# APPLICATION NAME AND SLOGAN:
|
||||
|
||||
APP_NAME => 'My Application',
|
||||
APP_MNEMO => 'App',
|
||||
APP_SLOGAN => '',
|
||||
|
||||
# APP FOLDERS & RESOURCE URL:
|
||||
|
||||
DIR_APP => getcwd(),
|
||||
DIR_TEMPLATES => strval(getcwd(), '/templates'),
|
||||
DIR_UPLOADS => strval(getcwd(), '/uploads'),
|
||||
ROOT_WWW => '/',
|
||||
|
||||
# DATABASE ACCESS CONFIGURATION:
|
||||
|
||||
DB_DSN => 'DBI:mysql:database=dbname;host=hostname',
|
||||
DB_USER => 'user',
|
||||
DB_PASSWORD => 'password',
|
||||
|
||||
# LDAP DOMAIN/SERVER:
|
||||
|
||||
LDAP_DOMAIN => '',
|
||||
|
||||
# MESSAGES TRANSLATION:
|
||||
|
||||
l10n => 'EN_en',
|
||||
|
||||
# MAX SIZE FOR UPLOADED FILES (5MB):
|
||||
|
||||
UPLOAD_MAX_FILESIZE => 5 * 1024 * 1024,
|
||||
|
||||
# FOOTER COPYRIGHT:
|
||||
|
||||
FOOTER_COPYRIGHT => strval('© ', $y, ' Made with Dam Framework'),
|
||||
|
||||
# VERSION VARIABLES:
|
||||
|
||||
VERSION => '0.01',
|
||||
REF_LAST_CHANGELOG => \@LAST_CHANGELOG,
|
||||
REF_PREV_CHANGELOG => \@PREV_CHANGELOG,
|
||||
|
||||
# ACCESS GROUPS FOR USERS REFERENCE:
|
||||
|
||||
REF_ACCESS_GROUPS => \@ACCESS_GROUPS,
|
||||
|
||||
# MENU REFERENCES:
|
||||
|
||||
REF_ROUTES => \%ROUTES,
|
||||
REF_USER_MENU => \%USER_MENU
|
||||
);
|
||||
|
||||
|
||||
|
||||
# GLOBAL VARIABLES:
|
||||
|
||||
my %GLOBAL_VARS = ();
|
||||
|
||||
|
||||
|
||||
# RESERVED VARIABLES:
|
||||
|
||||
# Error, warning, information and debug messages:
|
||||
my @REPORT_ERROR = ();
|
||||
my @REPORT_WARNING = ();
|
||||
my @REPORT_INFO = ();
|
||||
my @DEBUG_INFO = ();
|
||||
|
||||
|
||||
my %RESERVED_VARS = (
|
||||
|
||||
# CGI APP:
|
||||
|
||||
CGIAPP => undef,
|
||||
|
||||
# ERROR, WARNING, INFORMATION AND DEBUG MESSAGES:
|
||||
|
||||
REF_REPORT_ERROR => \@REPORT_ERROR,
|
||||
REF_REPORT_WARNING => \@REPORT_WARNING,
|
||||
REF_REPORT_INFO => \@REPORT_INFO,
|
||||
REF_DEBUG_INFO => \@DEBUG_INFO,
|
||||
|
||||
# CURRENT REPORT:
|
||||
|
||||
REF_CURRENT_PACKAGE => undef
|
||||
);
|
||||
|
||||
|
||||
|
||||
=head2 CONFIG($variable, $value)
|
||||
|
||||
Mantiene una estructura global de variables ($variable => $value).
|
||||
|
||||
=cut
|
||||
|
||||
sub CONFIG {
|
||||
push(@_, undef) if @_ % 2;
|
||||
my %variables = @_;
|
||||
|
||||
my @variables = keys(%variables);
|
||||
if (!@variables) {
|
||||
foreach my $var (keys(%CONFIG_VARS)) {
|
||||
info($var, ' => ', strval($CONFIG_VARS{$var}));
|
||||
}
|
||||
fatal('Global configuration variable name is required');
|
||||
}
|
||||
|
||||
my $variable;
|
||||
foreach my $var (@variables) {
|
||||
fatal('Global configuration variable "', $var, '" doesn\'t exist') if !exists($CONFIG_VARS{$var});
|
||||
if (defined($variables{$var})) {
|
||||
fatal('Global configuration variables cannot be deleted (see "', $var, '")') if is_eq($variables{$var}, DELETE_VAR);
|
||||
$CONFIG_VARS{$var} = $variables{$var};
|
||||
}
|
||||
$variable = $var;
|
||||
}
|
||||
return $CONFIG_VARS{$variable};
|
||||
}
|
||||
|
||||
|
||||
|
||||
=head2 GLOBAL($variable, $value)
|
||||
|
||||
Mantiene una estructura global de variables ($variable => $value).
|
||||
|
||||
=cut
|
||||
|
||||
sub GLOBAL {
|
||||
push(@_, undef) if @_ % 2;
|
||||
my %variables = @_;
|
||||
|
||||
my @variables = keys(%variables);
|
||||
if (!@variables) {
|
||||
foreach my $var (keys(%GLOBAL_VARS)) {
|
||||
info($var, ' => ', strval($GLOBAL_VARS{$var}));
|
||||
}
|
||||
fatal('Global variable name is required');
|
||||
}
|
||||
|
||||
my $variable;
|
||||
foreach my $var (@variables) {
|
||||
__assign(\%GLOBAL_VARS, \%variables, $var);
|
||||
$variable = $var;
|
||||
}
|
||||
return exists($GLOBAL_VARS{$variable}) ? $GLOBAL_VARS{$variable} : undef;
|
||||
}
|
||||
|
||||
|
||||
|
||||
=head2 RESERVED($variable, $value)
|
||||
|
||||
Mantiene una estructura global de variables ($variable => $value).
|
||||
|
||||
=cut
|
||||
|
||||
sub RESERVED {
|
||||
my $caller = caller();
|
||||
$caller = substr($caller, 0, index($caller, '::'));
|
||||
fatal('Reserved variables can only be used by Dam framework') if !is_eq($caller, 'Dam');
|
||||
|
||||
push(@_, undef) if @_ % 2;
|
||||
my %variables = @_;
|
||||
|
||||
my @variables = keys(%variables);
|
||||
if (!@variables) {
|
||||
foreach my $var (keys(%RESERVED_VARS)) {
|
||||
info($var, ' => ', strval($RESERVED_VARS{$var}));
|
||||
}
|
||||
fatal('Reserved variable name is required');
|
||||
}
|
||||
|
||||
my $variable;
|
||||
foreach my $var (@variables) {
|
||||
__assign(\%RESERVED_VARS, \%variables, $var);
|
||||
$variable = $var;
|
||||
}
|
||||
return exists($RESERVED_VARS{$variable}) ? $RESERVED_VARS{$variable} : undef;
|
||||
}
|
||||
|
||||
|
||||
# PRIVATE FUNCTIONS:
|
||||
|
||||
|
||||
sub __assign {
|
||||
my ($VARS_ref, $variables_ref, $var) = @_;
|
||||
|
||||
if (defined($$variables_ref{$var})) {
|
||||
if (is_eq($$variables_ref{$var}, UNDEF_VAR)) {
|
||||
$$VARS_ref{$var} = undef;
|
||||
}
|
||||
elsif (is_eq($$variables_ref{$var}, DELETE_VAR)) {
|
||||
delete($$VARS_ref{$var});
|
||||
}
|
||||
else {
|
||||
$$VARS_ref{$var} = $$variables_ref{$var};
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
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
|
||||
Reference in a new issue