#!/usr/bin/perl
use strict;
use CGI::Carp qw/fatalsToBrowser/;
use CGI;
#print "Content-type: text/html\n\n";
####################################################################
#This are the only customization that should be done in this script:
####################################################################
# This is the FULL PATH (NOT URL that starts with http://) to the
# "news.config" database file. It is recommended (and by default)
# that it is placed at http://www.upoint.net/cgi-bin/headlines/news.config".
# For example: "/home/upoint/www/cgi-bin/headlines/news.config"
my $configFile = "/home/fjsaenz/ftp/headlines/news.config";
# This is the FULL URL (NOT SERVER PATH) to the "categories" folder (ends with a slash):
# For example: "http://www.marchamediterraneo.com/categories/"
my $categoriesURL = "http://www.fjsaenz.com/headlines/categories/";
# This is the FULL URL (NOT SERVER PATH) to the "pics" folder (ends with a slash):
# For example: "http://www.upoint.net/headlines/pics/"
my $picsURL = "http://www.fjsaenz.com/headlines/pics/";
####################################################################
# End of configuration in this script
####################################################################
&main;
#
sub main {
my %config = &readConfig($configFile);
my $q = new CGI;
$CGI::POST_MAX = $config{'maxContentLength'};
$CGI::DISABLE_UPLOADS = 1;
if (scalar($q->param) == 0) {
&display($q, 0, \%config);
exit;
}
elsif (!defined($q->param('mode'))) {
&display($q, 0, \%config);
exit;
}
elsif ($q->param('mode') eq 'redirect') {
print $q->redirect($config{'calledBy'});
exit;
}
elsif ($q->param('mode') eq 'display') {
&display($q, 0, \%config);
exit;
}
elsif ($q->param('mode') eq 'admin') {
&admin($q,\%config);
exit;
}
elsif ($q->param('mode') eq 'popup') {
&popUp($q,\%config);
exit;
}
elsif ($q->param('mode') eq 'viewCat') {
&viewCategory($q,\%config);
exit;
}
exit;
}
#
sub admin {
my $q = shift;
my %config = %{$_[0]};
if ( defined($q->param('encpass')) ) {
if ( $q->param('encpass') eq $config{'password'} ) {
&menu($q, \%config);
exit;
}
}
if (!defined($q->param('password'))) {
$q->param(-name=>'password',-Value=>'');
}
if ( &checkPassword($q->param('password'), $config{'password'}) ) {
&menu($q, \%config);
}
else {
print $q->header(-type=>'text/html');
print $q->start_html(-title=>'Acceso de Administrador');
print $q->p($q->h1('Acceso de Administrador'));
if ( $q->param('password') ne '' ) {
print "
Has escrito mal la contraseña. Por favor recuerde que la contraseña es case sensitive.
\n";
}
print "
Por favor introduzca la contraseña de Administrador debajo:
Haga clic si quiere que el título aparezca como un vínculo: (PopUp) \n ";
print $q->checkbox(-name=>'link',
-value=>'1',
-label=>'Haga clic para usar una ventana pop up',
-checked=>$link);
print "
Para cambiar la imagen mostrada en la pop up, elija una imagen de debajo: \n ";
print $q->filefield(-name=>'picture',
-default=>'',
-size=>80,
-maxlength=>200);
print '
Ver Categoria de Iconos";
}
print $q->endform;
print ' Volver al menú principal';
print $q->end_html;
}
#
sub delCategory {
my $q = shift;
my %config = %{$_[0]};
my @categories = grep {
substr($_,0,3) eq 'Cat'
} keys %config;
@categories = sort {$a cmp $b} map { substr( $_, 3, length($_)-3 ) } @categories;
if ( defined($q->param('delcat')) && defined($q->param('confirmation')) && $q->param('confirmation') eq 'okay' ) {
my $delcat = $q->param('delcat');
my @delEntries;
my @db;
unlink($config{'scriptDir'}.$config{'catRelDir'}.$config{'Cat'.$delcat});
open (DB, "+<$config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}")
or die "Could not open db file $config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}: $!";
flock (DB, 2)
or die "Could not lock db file $config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}: $!";
my $index=0;
while () {
push(@db, $_);
(my $key, my $value) = split ('=', $db[-1]);
if ( $key eq '!category' && $value eq $delcat."\n") {
push(@delEntries, ($index-5));
}
$index++;
}
$index = 0;
foreach $index (@delEntries) {
(undef, my $delImage) = split('=', $db[$index+4]);
$delImage = $config{'scriptDir'} . $config{'picRelDir'} . $delImage;
chomp $delImage;
if ( substr($delImage, length($delImage)-3, 3) eq 'jpg' || substr($delImage, length($delImage)-3, 3) eq 'gif') {
unlink($delImage);
}
$db[$index+0] = '';
$db[$index+1] = '';
$db[$index+2] = '';
$db[$index+3] = '';
$db[$index+4] = '';
$db[$index+5] = '';
}
seek (DB,0,0)
or die "Could not seek db file $config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}: $!";
truncate(DB,0)
or die "Could not truncate db file $config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}: $!";
foreach (@db) { print DB $_ }
close (DB)
or die "Could not close db file $config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}: $!";
open(CONFIG, "+<$configFile")
or die "Could not open config file $configFile: $!";
flock (CONFIG, 2)
or die "Could not lock config file $configFile: $!";
my @rawConfig = ;
seek (CONFIG, 0, 0)
or die "Could not seek config file $configFile: $!";
truncate (CONFIG, 0)
or die "Could not truncate config file $configFile: $!";
my $line;
$delcat = 'Cat'.$delcat.'=';
foreach $line (@rawConfig) {
unless ( $line =~ /^$delcat/ ) {
print CONFIG $line;
}
}
close (CONFIG)
or die "Could not close config file $configFile: $!";
print $q->redirect($config{'absScriptFile'}.'?mode=admin&encpass=' . $config{'password'});
exit;
}
print $q->header(-type=>'text/html');
print $q->start_html(-title=>'Administración de Noticias: Borrar Categoría de Noticias');
print $q->p($q->h1('Administración de Noticias: Borrar Categoría de Noticias'));
print $q->startform(-method=>'POST',
-action=>'headlines.cgi',
-enctype=>&CGI::MULTIPART);
print $q->hidden(-name=>'encpass',
-default=>$config{'password'});
print $q->hidden(-name=>'mode',
-default=>'admin');
print $q->hidden(-name=>'section',
-default=>'delCategory');
if ( defined($q->param('delcat')) ) {
print $q->hidden(-name=>'delcat',
-default=>$q->param('delcat'));
print $q->hidden(-name=>'confirmation',
-default=>'okay');
print "Por favor confirme el borrado haciendo clic en Confirmar.
";
print $q->submit(-name=>'Confirm',
-Value=>'Confirmar');
}
else {
print 'Advertencia: El borrar categorías significa borrar todas las entradas de noticias asociadas también.
Volver al Menú Principal';
print $q->end_html;
}
#
sub editTemplate {
my $q = shift;
my %config = %{$_[0]};
my $error;
if ( defined($q->param('newtmpl')) && defined($q->param('newtmpl2')) ) {
unless (
$q->param('newtmpl') =~ // ||
$q->param('newtmpl2') =~ //
) {
open (DB, "+<$config{'scriptDir'}$config{'templateRelDir'}$config{'templateFile'}")
or die "Could not open template file $config{'scriptDir'}$config{'templateRelDir'}$config{'templateFile'}: $!";
flock (DB, 2)
or die "Could not lock template file $config{'scriptDir'}$config{'templateRelDir'}$config{'templateFile'}: $!";
seek (DB,0,0)
or die "Could not seek template file $config{'scriptDir'}$config{'templateRelDir'}$config{'templateFile'}: $!";
truncate(DB,0)
or die "Could not truncate db file $config{'scriptDir'}$config{'templateRelDir'}$config{'templateFile'}: $!";
print DB $q->param('newtmpl').''.$q->param('newtmpl2');
close (DB)
or die "Could not close template file $config{'scriptDir'}$config{'templateRelDir'}$config{'templateFile'}: $!";
print $q->redirect($config{'absScriptFile'}.'?mode=admin&encpass=' . $config{'password'});
exit;
}
else { $error = 'The template must not contain <!--INSERTNEWS-->
'}
}
my @data;
open (DB, "<$config{'scriptDir'}$config{'templateRelDir'}$config{'templateFile'}")
or die "Could not open template file $config{'scriptDir'}$config{'templateRelDir'}$config{'templateFile'}: $!";
flock (DB, 1)
or die "Could not lock template file $config{'scriptDir'}$config{'templateRelDir'}$config{'templateFile'}: $!";
@data = ;
close (DB)
or die "Could not close template file $config{'scriptDir'}$config{'templateRelDir'}$config{'templateFile'}: $!";
my $string = join ('', @data);
(my $before, my $after) = split('', $string);
print $q->header(-type=>'text/html');
print $q->start_html(-title=>'Administración de Noticias: Editar Plantilla');
print $q->p($q->h1('Administración de Noticias: Editar Plantilla'));
print $error;
print $q->startform(-method=>'POST',
-action=>'headlines.cgi',
-enctype=>&CGI::MULTIPART);
print $q->hidden(-name=>'encpass',
-default=>$config{'password'});
print $q->hidden(-name=>'mode',
-default=>'admin');
print $q->hidden(-name=>'section',
-default=>'editTemplate');
print 'HTML a mostrar antes de las noticias:
Volver al Menú Principal';
print $q->end_html;
}
#
sub changePassword {
my $q = shift;
my %config = %{$_[0]};
my $error;
if ( !defined($q->param('oldpass')) ) {
$q->param('oldpass', '');
}
else {
if ( !&checkPassword($q->param('oldpass'), $config{'password'}) ) {
$error = 'La contraseña antigua que ha introducido es incorrecta. Por favor inténtelo de nuevo. Recuerde que las contraseñas son case sensitive.
';
}
elsif ( !defined($q->param('newpass')) || !defined($q->param('newpass2')) ||
length($q->param('newpass')) < 4 || length($q->param('newpass2')) < 4
) {
$error = 'Por favor introduzca las nuevas contraseñas con un mínimo de 4 caracteres!
';
}
elsif ($q->param('newpass') ne $q->param('newpass2')) {
$error = 'Las nuevas contraseñas no coinciden!
';
}
elsif ( defined($q->param('newpass')) && defined($q->param('newpass2')) &&
$q->param('newpass') eq $q->param('newpass2')
) {
$config{'password'} = crypt($q->param('newpass'), join ( '', ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64] ));
unless ( open(CONFIG, "+<$configFile") ) {
die("Could not open configuration file $configFile: $!");
}
flock(CONFIG, 2)
or die "Could not lock file $configFile: $!";
my @conf;
while () {
push (@conf, $_);
(my $key, undef) = split ('=', $conf[-1]);
if ($key eq 'password') {
$conf[-1] = 'password='.$config{'password'}."\n";
}
}
seek (CONFIG,0,0)
or die "Could not seek file $configFile: $!";
truncate(CONFIG,0)
or die "Could not truncate file $configFile: $!";
my $line;
foreach $line (@conf) { print CONFIG $line; }
close CONFIG
or die "Could not close file $configFile: $!";
print $q->redirect($config{'absScriptFile'}.'?mode=admin&encpass=' . $config{'password'});
exit;
}
}
print $q->header(-type=>'text/html');
print $q->start_html(-title=>'Administración de Noticias: Cambiar Contraseña');
print $q->p($q->h1('Administración de Noticias: Cambiar Contraseña'));
print $error;
print $q->startform(-method=>'POST',
-action=>'headlines.cgi',
-enctype=>&CGI::MULTIPART);
print $q->hidden(-name=>'encpass',
-default=>$config{'password'});
print $q->hidden(-name=>'mode',
-default=>'admin');
print $q->hidden(-name=>'section',
-default=>'changePassword');
print 'Por favor introduzca la contraseña antigua debajo: ';
print $q->password_field(-name=>'oldpass', -size=>30, -maxlength=>30);
print '
Por favor introduzca la nueva contraseña debajo: ';
print $q->password_field(-name=>'newpass', -size=>30, -maxlength=>30);
print '
Por favor re-introduzca la nueva contraseña debajo: ';
print $q->password_field(-name=>'newpass2', -size=>30, -maxlength=>30);
print '
Volver al Menú Principal';
print $q->end_html;
exit;
}
#
sub delNews {
my $q = shift;
my %config = %{$_[0]};
if ( (defined($q->param('confirmation')) && $q->param('confirmation') eq 'okay') ) {
open (DB, "+<$config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}")
or die "Could not open db file $config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}: $!";
flock (DB, 2)
or die "Could not lock db file $config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}: $!";
my @db;
while () { push (@db, $_) }
(undef, my $delImage) = split('=', $db[$q->param('delNews')+4]);
$db[$q->param('delNews')+0] = '';
$db[$q->param('delNews')+1] = '';
$db[$q->param('delNews')+2] = '';
$db[$q->param('delNews')+3] = '';
$db[$q->param('delNews')+4] = '';
$db[$q->param('delNews')+5] = '';
$delImage = $config{'scriptDir'} . $config{'picRelDir'} . $delImage;
chomp $delImage;
seek (DB,0,0)
or die "Could not seek db file $config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}: $!";
truncate(DB,0)
or die "Could not truncate db file $config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}: $!";
my $line;
foreach $line (@db) { print DB $line }
close (DB)
or die "Could not close db file $config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}: $!";
if ( substr($delImage, length($delImage)-3, 3) eq 'jpg' || substr($delImage, length($delImage)-3, 3) eq 'gif') {
unlink($delImage);
}
print $q->redirect($config{'absScriptFile'}.'?mode=admin&encpass=' . $config{'password'});
exit;
}
print $q->header(-type=>'text/html');
print $q->start_html(-title=>'Administracion de Noticias: Borrar Entrada de Noticias');
print $q->p($q->h1('Administracion de Noticias: Borrar Entrada de Noticias'));
print $q->startform(-method=>'POST',
-action=>'headlines.cgi',
-enctype=>&CGI::MULTIPART);
print $q->hidden(-name=>'encpass',
-default=>$config{'password'});
print $q->hidden(-name=>'mode',
-default=>'admin');
print $q->hidden(-name=>'section',
-default=>'delNews');
if ( !defined($q->param('delNews')) ) {
&display($q, 'Borrar la entrada de noticias siguiente:', \%config);
print '
';
print $q->submit(-name=>'Delete',
-Value=>'Borrar');
}
if ( defined($q->param('delNews')) ) {
print $q->hidden(-name=>'delNews',
-default=>$q->param('delNews'));
print $q->hidden(-name=>'confirmation',
-default=>'okay');
print "Por favor confirme el borrado haciendo clic en Confirmar.
Volver al Menú Principal';
print $q->end_html;
}
#
sub editOptions {
my $q = shift;
my %config = %{$_[0]};
if ( (defined($q->param('editoptions')) && $q->param('editoptions') eq 'yes') ) {
my ($hKey, $hValue);
my @sortedKeys = sort keys %config;
open (CONFIG, ">$config{'scriptDir'}$config{'dbRelDir'}news.config.bak")
or die "Could not open bak file $config{'scriptDir'}$config{'dbRelDir'}news.config.bak: $!";
flock (CONFIG, 2)
or die "Could not lock bak file $config{'scriptDir'}$config{'dbRelDir'}news.config.bak: $!";
foreach $hKey ( @sortedKeys ) {
$hValue = $config{$hKey};
$hKey =~ s/=/=/g;
$hValue =~ s/=/=/g;
print CONFIG $hKey.'='.$hValue."\n";
}
close (CONFIG)
or die "Could not close bak file $config{'scriptDir'}$config{'dbRelDir'}news.config.bak: $!";
open (CONFIG, ">$configFile")
or die "Could not open config file $configFile: $!";
flock (CONFIG, 2)
or die "Could not lock config file $configFile: $!";
foreach $hKey ( @sortedKeys ) {
if ( defined($q->param('EditKey'.$hKey)) ) {
$hValue = $q->param('EditKey'.$hKey);
}
else {
$hValue = $config{$hKey};
}
$hValue =~ s/=/=/g;
$hKey =~ s/=/=/g;
print CONFIG $hKey . '=' . $hValue . "\n";
}
close (CONFIG)
or die "Could not close config file $configFile: $!";
print $q->header(-type=>'text/html');
print $q->start_html(-title=>'Administración de Noticias: Editar Otras Opciones');
print $q->p($q->h1('Administración de Noticias: Editar Otras Opciones'));
print $q->startform(-method=>'POST',
-action=>'headlines.cgi',
-enctype=>&CGI::MULTIPART);
print $q->hidden(-name=>'encpass',
-default=>$config{'password'});
print $q->hidden(-name=>'mode',
-default=>'admin');
print 'The options have been altered.
';
print $q->submit(-name=>'Return to Main Menu',
-Value=>'Volver al menú principal');
print $q->endform;
print $q->end_html;
exit;
}
print $q->header(-type=>'text/html');
print $q->start_html(-title=>'Administración de Noticias: Editar Otras Opciones');
print $q->p($q->h1('Administración de Noticias: Editar Otras Opciones'));
print $q->startform(-method=>'POST',
-action=>'headlines.cgi',
-enctype=>&CGI::MULTIPART);
print $q->hidden(-name=>'encpass',
-default=>$config{'password'});
print $q->hidden(-name=>'mode',
-default=>'admin');
print $q->hidden(-name=>'section',
-default=>'editOptions');
print $q->hidden(-name=>'editoptions',
-default=>'yes');
print 'For safety reasons, the current configuration will be backed up. You can change the following options:
Volver al Menú Principal';
print $q->end_html;
}
#
sub delAllNews {
my $q = shift;
my %config = %{$_[0]};
if ( (defined($q->param('confirmation')) && $q->param('confirmation') eq 'okay') ) {
open (DB, "+<$config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}")
or die "Could not open db file $config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}: $!";
flock (DB, 2)
or die "Could not lock db file $config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}: $!";
my @db;
while () {
(my $label, my $value) = split('=', $_);
if ($label eq '!picture') {
$value = $config{'scriptDir'} . $config{'picRelDir'} . $value;
chomp $value;
if ( substr($value, length($value)-3, 3) eq 'jpg' || substr($value, length($value)-3, 3) eq 'gif') {
my $test = unlink($value);
unless ($test) {die "Image deletion failed! $!";}
}
}
}
seek (DB,0,0)
or die "Could not seek db file $config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}: $!";
truncate(DB,0)
or die "Could not truncate db file $config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}: $!";
close (DB)
or die "Could not close db file $config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}: $!";
print $q->redirect($config{'absScriptFile'}.'?mode=admin&encpass=' . $config{'password'});
exit;
}
print $q->header(-type=>'text/html');
print $q->start_html(-title=>'News Administration: Delete All News Entries');
print $q->p($q->h1('News Administration: Delete All News Entries'));
print $q->startform(-method=>'POST',
-action=>'headlines.cgi',
-enctype=>&CGI::MULTIPART);
print $q->hidden(-name=>'encpass',
-default=>$config{'password'});
print $q->hidden(-name=>'mode',
-default=>'admin');
print $q->hidden(-name=>'section',
-default=>'delAllNews');
print $q->hidden(-name=>'confirmation',
-default=>'okay');
print 'Please confirm the deletion of all news entries:
Volver al Menú Principal';
print $q->end_html;
}
#
sub addNews {
$CGI::DISABLE_UPLOADS = 0;
my $q = shift;
my %config = %{$_[0]};
my $fileType;
my @categories = grep {
substr($_,0,3) eq 'Cat'
} keys %config;
@categories = sort {$a cmp $b} map { substr( $_, 3, length($_)-3 ) } @categories;
if ( defined($q->param('head')) && defined($q->param('text')) && defined($q->param('image')) && defined($q->param('category'))) {
if ( length($q->param('image')) > 3 && $q->param('link') eq '1' ) {
$fileType = $q->uploadInfo($q->param('image'))->{'Content-Type'};
unless ($fileType eq 'image/gif' || $fileType eq 'image/pjpeg') {
die "IMAGES FILES ONLY!";
}
}
open (DB, "+<$config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}")
or die "Could not open db file $config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}: $!";
flock (DB, 2)
or die "Could not lock db file $config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}: $!";
my @db;
while () { push (@db, $_) }
seek (DB,0,0)
or die "Could not seek db file $config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}: $!";
truncate(DB,0)
or die "Could not truncate db file $config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}: $!";
my $head = $q->param('head');
$head =~ s/\r\n?/\n/g;
$head =~ s/=/=/g;
print DB '!head='.$head."\n";
print DB '!link='.(defined($q->param('link')) && $q->param('link') ne '' ? 1 : 0)."\n";
my $text = $q->param('text');
$text =~ s/\r\n?/\n/g;
$text =~ s/=/=/g;
$text =~ s/\n/\ /gi;
print DB '!text='.$text."\n";
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
print DB '!date='.join('.', ($mday,$mon+1,$year+1900))."\n";
if ( length($q->param('image')) <= 3 || $q->param('link') ne '1' ) {
print DB '!picture= '."\n";
}
else {
my $name = $sec+$min*60+$hour*3600+$yday*3600*24+$year*3600*24*365;
if ($fileType eq 'image/gif') {$name = $name . '.gif'}
if ($fileType eq 'image/pjpeg') {$name = $name . '.jpg'}
print DB '!picture='.$name."\n";
open(FILE, ">$config{'scriptDir'}$config{'picRelDir'}$name")
or die "Could not open image file $config{'scriptDir'}$config{'picRelDir'}$name: $!";
flock (FILE, 2)
or die "Could not lock image file $config{'scriptDir'}$config{'picRelDir'}$name: $!";
binmode(FILE)
or die "Could not set image file to binmode $config{'scriptDir'}$config{'picRelDir'}$name: $!";
my($bytes_read, $buf);
my($total_size) = 0;
while ($bytes_read = read($q->param('image'), $buf, 2048) )
{
$total_size += $bytes_read;
print FILE $buf;
}
close(FILE)
or die "Could not close image file $config{'scriptDir'}$config{'picRelDir'}$name: $!";
}
print DB '!category='.$q->param('category')."\n";
my $line;
foreach $line (@db) { print DB $line }
close (DB)
or die "Could not close db file $config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}: $!";
print $q->redirect($config{'absScriptFile'}.'?mode=admin&encpass=' . $config{'password'});
}
print $q->header(-type=>'text/html');
print $q->start_html(-title=>'News Administration: Add News Entry');
print $q->p($q->h1('News Administration: Add News Entry'));
print "
Category to create the entry in: \n ";
print $q->popup_menu(-name=>'category',
-Values=>[@categories]);
print "
Check if you want the headline to be displayed as a link: (PopUp) \n ";
print $q->checkbox(-name=>'link',
-value=>'1',
-label=>'Check to use pop up window');
print "
Choose an image for upload in case you use a pop up window: \n ";
print $q->filefield(-name=>'image',
-default=>'',
-size=>80,
-maxlength=>200);
print "
Volver al Menú Principal';
print $q->end_html;
}
#
sub checkPassword {
if ( crypt( $_[0], $_[1] ) eq $_[1] ) {
return 1;
}
else {
return 0;
}
}
#
sub readConfig {
# reads configuration file and returns relevant data (see below)
my %config;
unless ( open(CONFIG, "<$_[0]") ) {
print "Configuration File $_[0] not found $!";
die("file not found");
}
flock(CONFIG, 1)
or die "Could not lock file $_[0]: $!";
while () {
chomp;
(my $key, my $content) = split ('=', $_);
$key =~ s/=/=/g;
$content =~ s/=/=/g;
$config{$key} = $content;
}
close CONFIG
or die "Could not close file $_[0]: $!";
return %config;
}
#
sub display {
my $q = shift;
my $delete = shift;
my %config = %{$_[0]};
my @lines = ();
my $index = 0;
my $end;
my $start;
unless ($delete) {
print "Content-type:text/html\n\n";
open (TMPL, "<$config{'scriptDir'}$config{'templateRelDir'}$config{'templateFile'}")
or die "Could not open template file $config{'scriptDir'}$config{'templateRelDir'}$config{'templateFile'}: $!";
flock (TMPL, 1)
or die "Could not lock template file $config{'scriptDir'}$config{'templateRelDir'}$config{'templateFile'}: $!";
{
my @template;
while () {
push ( @template, $_ );
}
$start = join (' ', @template);
($start, $end) = split ( '', $start );
print $start;
}
close (TMPL)
or die "Could not close template file $config{'scriptDir'}$config{'templateRelDir'}$config{'templateFile'}: $!";
}
open (DB, "<$config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}")
or die "Could not open db file $config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}: $!";
flock (DB, 1)
or die "Could not lock db file $config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}: $!";
while () {
push ( @lines, (split('=', $_))[1] );
}
chop @lines;
close (DB)
or die "Could not close db file $config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}: $!";
my $day;
my $month;
my $year;
print <<"EOM";
EOM
my $newsDisplayed = 0;
for ($index = 0;
$index < scalar(@lines);
$index += 6
) {
if ( defined($q->param('limcat')) &&
$q->param('limcat') ne $lines[$index+5]
) { next }
if ( defined($q->param('maxnews')) &&
$q->param('maxnews') <= $newsDisplayed
) { last }
$newsDisplayed++;
if ($delete) {
print ' ' . $delete . ' ';
}
print ' \n";
print '';
($day, $month, $year) = split (/\./, $lines[$index+3]);
print $config{'dateAttributesBegin'};
print $day . ' ' . $config{'month'.$month} . ' ' . $year;
print $config{'dateAttributesEnd'};
print " \n";
print '';
print $config{'headAttributesBegin'};
if ( $config{'newIconDisplay'} eq '1') {
my (undef,undef,undef,$nowmday,$nowmon,$nowyear,undef,undef,undef) = localtime(time);
$nowyear=$nowyear+1900;
my @days = (0,31,59,90,120,151,181,212,243,273,304,334);
if ( $config{'newIconMaxAge'} >
(
($nowyear*365+$days[$nowmon]+$nowmday) -
($year*365+$days[$month-1]+$day)
)
) {
print ' \n";
}
}
if ($lines[$index+1] ne '0' && $lines[$index+1] ne '') {
my $url = $config{'absScriptFile'};
my ($protocol, $address) = split('://', $url);
$protocol = 'http';
print "";
}
print $lines[$index];
if ($lines[$index+1] ne '0' && $lines[$index+1] ne '') {
print '';
}
print $config{'headAttributesEnd'};
print " \n";
if ($lines[$index+1] eq '0' || $lines[$index+1] eq '') {
print '';
print $config{'textAttributesBegin'};
$lines[$index+2] =~ s/=/=/g;
print $lines[$index+2];
print $config{'textAttributesEnd'};
print " \n";
}
print " \n";
}
unless ($delete) {
print $end;
}
}
#
sub viewCategory {
my $q = shift;
my %config = %{$_[0]};
my @categories = grep {
substr($_,0,3) eq 'Cat'
} keys %config;
@categories = sort {$a cmp $b} map { substr( $_, 3, length($_)-3 ) } @categories;
print $q->header(-type=>'text/html');
print $q->start_html(-title=>'Available Categories');
print $q->p($q->h1('Available Categories'));
foreach my $category (@categories) {
print ' ' . $category . '
';
}
print 'Cerrar';
print $q->end_html;
}
#
sub popUp {
my $q = shift;
my %config = %{$_[0]};
my @lines = ();
my $index = $q->param('num');
open (DB, "<$config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}")
or die "Could not open db file $config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}: $!";
flock (DB, 1)
or die "Could not lock db file $config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}: $!";
while () {
push ( @lines, (split('=', $_))[1] );
}
chop @lines;
close (DB)
or die "Could not close db file $config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}: $!";
my $day;
my $month;
my $year;
($day, $month, $year) = split (/\./, $lines[$index+3]);
# Página html LOGOTIPO
print $q->header(-type=>'text/html');
print $q->start_table();
print '