#!/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:

\n"; print "

\n"; print $q->startform(-method=>'POST', -action=>'headlines.cgi', -enctype=>&CGI::MULTIPART); print $q->hidden(-name=>'mode', -default=>'admin'); print $q->password_field(-name=>'password', -size=>30, -maxlength=>30); print "

\n"; print $q->submit(-name=>'Log in', -Value=>'Entrar'); print $q->endform; print "

\n"; print $q->end_html; } exit; } # sub menu { my $q = shift; my %config = %{$_[0]}; if ($q->param('section') eq 'addNews') { &addNews($q,\%config); exit; } elsif ($q->param('section') eq 'editNews') { &editNews($q,\%config); exit; } elsif ($q->param('section') eq 'delNews') { &delNews($q,\%config); exit; } elsif ($q->param('section') eq 'delAllNews') { &delAllNews($q,\%config); exit; } elsif ($q->param('section') eq 'display') { print $q->redirect($config{'calledBy'}); exit; } elsif ($q->param('section') eq 'changePassword') { &changePassword($q,\%config); exit; } elsif ($q->param('section') eq 'editTemplate') { &editTemplate($q,\%config); exit; } elsif ($q->param('section') eq 'editOptions') { &editOptions($q,\%config); exit; } elsif ($q->param('section') eq 'addCategory') { &addCategory($q,\%config); exit; } elsif ($q->param('section') eq 'delCategory') { &delCategory($q,\%config); exit; } print $q->header(-type=>'text/html'); print $q->start_html(-title=>'Administración de Noticias: Menú Principal'); print $q->p($q->h1('Administración de Noticias: Menú Principal')); 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'); my %labels = ('addNews',' Añadir entrada de Noticias', 'editNews',' Editar entrada de Noticias', 'delNews',' Borrar entrada de Noticias', 'delAllNews',' Borrar todas las entradas', 'editTemplate',' Editar Plantilla', 'addCategory',' Añadir nueva categoría de Noticias', 'delCategory',' Borrar categoría de Noticias', 'editOptions',' Editar otras opciones', 'changePassword',' Cambiar contraseña', 'display', ' Ver las Noticias'); print $q->radio_group(-name=>'section', -values=>['addNews','editNews','delNews','delAllNews','editTemplate','addCategory','delCategory','editOptions','changePassword','display'], -default=>'', -linebreak=>'true', -labels=>\%labels, -columns=>2); print "
\n"; print $q->submit(-name=>'Submit', -Value=>'Enviar'); print $q->endform; print $q->end_html; } # sub editNews { my $q = shift; my %config = %{$_[0]}; $CGI::DISABLE_UPLOADS = 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('confirmation')) && $q->param('confirmation') eq 'okay' ) { my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); my @db; 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'}: $!"; while () { push (@db, $_) } my $text = $q->param('text') if defined($q->param('text')); $text =~ s/\r\n?/\n/g; $text =~ s/=/=/g; $text =~ s/\n/\/gi; (undef, my $delImage) = split('=', $db[$q->param('delNews')+4]); (undef, my $date) = split('=', $db[$q->param('delNews')+3]); chomp $date; if ( defined($q->param('date')) && $q->param('date') eq '1') { $date = join('.', ($mday,$mon+1,$year+1900)); } chomp $delImage; my $head = $q->param('head') if defined($q->param('head')); $head =~ s/\r\n?/\n/g; $head =~ s/=/=/g; my $picture = $q->param('picture') if defined($q->param('picture')); my $name = ' '; $name = $q->param('oldpicture') if ( defined($q->param('oldpicture')) && $q->param('link') eq '1' ); my $link = $q->param('link'); if ( $link ne '1' ) { $link = '0' } if ( defined($q->param('link')) && $q->param('link') eq '1' && defined($q->param('picture')) && (substr($q->param('picture'), length($q->param('picture'))-3, 3) eq 'jpg' || substr($q->param('picture'), length($q->param('picture'))-3, 3) eq 'gif') ) { my $fileType = $q->uploadInfo($q->param('picture'))->{'Content-Type'}; $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'} 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('picture'), $buf, 2048) ) { $total_size += $bytes_read; print FILE $buf; } close(FILE) or die "Could not close image file $config{'scriptDir'}$config{'picRelDir'}$name: $!"; } $db[$q->param('delNews')+0] = '!head=' . $head . "\n"; $db[$q->param('delNews')+1] = '!link=' . $link . "\n"; $db[$q->param('delNews')+2] = '!text=' . $text . "\n"; $db[$q->param('delNews')+3] = '!date=' . $date . "\n"; $db[$q->param('delNews')+4] = '!picture=' . $name . "\n"; $db[$q->param('delNews')+5] = '!category=' . $q->param('category') . "\n"; 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'}: $!"; unless ( $name eq $delImage ) { if ( substr($delImage, length($delImage)-3, 3) eq 'jpg' || substr($delImage, length($delImage)-3, 3) eq 'gif') { $delImage = $config{'scriptDir'} . $config{'picRelDir'} . $delImage; unlink($delImage); } } 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: Editar Entrada de Noticias'); print $q->p($q->h1('Administración de Noticias: Editar 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=>'editNews'); if ( !defined($q->param('delNews')) ) { &display($q, 'Editar la entrada seleccionada:', \%config); print $q->submit(-name=>'Editar la entrada seleccionada', -Value=>'Editar la entrada seleccionada'); } if ( defined($q->param('delNews')) ) { print $q->hidden(-name=>'delNews', -default=>$q->param('delNews')); print $q->hidden(-name=>'confirmation', -default=>'okay'); 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'}: $!"; my ($head,$link,$text,$date,$picture,$category); { my @db; while () { push (@db, $_) } (undef,$head) = split('=', $db[$q->param('delNews')+0]); (undef,$link) = split('=', $db[$q->param('delNews')+1]); (undef,$text) = split('=', $db[$q->param('delNews')+2]); (undef,$date) = split('=', $db[$q->param('delNews')+3]); (undef,$picture) = split('=', $db[$q->param('delNews')+4]); (undef,$category) = split('=', $db[$q->param('delNews')+5]); chomp ($head,$link,$text,$date,$picture,$category); $text =~ s/\/\n/gi; $text =~ s/=/=/g; $head =~ s/=/=/g; } close (DB) or die "Could not close db file $config{'scriptDir'}$config{'dbRelDir'}$config{'dbFile'}: $!"; print $q->hidden(-name=>'oldlink', -default=>$link); print $q->hidden(-name=>'oldpicture', -default=>$picture); print "¿Quiere actualizar a la fecha actual?
\n"; print $q->checkbox(-name=>'date', -value=>'1', -label=>'Si.'); print "

Titulo de las Noticia:
\n"; print $q->textfield(-name=>'head', -default=>$head, -size=>100, -maxlength=>200); print "

Texto de las Noticia:
\n"; print $q->textarea(-name=>'text', -default=>$text, -rows=>15, -columns=>80); print "

Categoría:
\n        "; print $q->popup_menu(-name=>'category', -Values=>[@categories], -default=>$category); print "

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 '

'; print $q->submit(-name=>'Change', -Value=>'Cambiar'); print <<"EOM"; EOM my $url = $config{'absScriptFile'}; my ($protocol, $address) = split('://', $url); $protocol = 'http'; 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.

'; print 'Categoría a borrar:

'; print $q->popup_menu(-name=>'delcat', -Values=>[@categories]); print '

'; print $q->submit(-name=>'Delete', -Value=>'Borrar'); } print $q->endform; print <<"EOM"; EOM my $url = $config{'absScriptFile'}; my ($protocol, $address) = split('://', $url); $protocol = 'http'; print "
View Category Icons"; print '

Volver al Menú Principal'; print $q->end_html; } # sub addCategory { 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('catimage')) && defined($q->param('catname')) ) { foreach (@categories) { if ( $q->param('catname') eq $_ ) { die "DUPLICATE CATEGORY NAME!"; } } if ( $q->param('catname') =~ /\W/ ) { die "ALPHANUMERIC NAMES ONLY!"; } elsif ( length($q->param('catimage')) > 3 ) { my $fileType = $q->uploadInfo($q->param('catimage'))->{'Content-Type'}; unless ($fileType eq 'image/gif' || $fileType eq 'image/pjpeg') { die "IMAGES FILE ONLY!"; } my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); 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'} open(CONFIG, ">>$configFile") or die "Could not open config file $configFile: $!"; flock (CONFIG, 2) or die "Could not lock config file $configFile: $!"; print CONFIG 'Cat'.$q->param('catname').'='.$name."\n"; close (CONFIG) or die "Could not close config file $configFile: $!"; open(FILE, ">$config{'scriptDir'}$config{'catRelDir'}$name") or die "Could not open image file $config{'scriptDir'}$config{'catRelDir'}$name: $!"; flock (FILE, 2) or die "Could not lock image file $config{'scriptDir'}$config{'catRelDir'}$name: $!"; binmode(FILE) or die "Could not set image file to binmode $config{'scriptDir'}$config{'catRelDir'}$name: $!"; my($bytes_read, $buf); my($total_size) = 0; while ($bytes_read = read($q->param('catimage'), $buf, 2048) ) { $total_size += $bytes_read; print FILE $buf; } close(FILE) or die "Could not close image file $config{'scriptDir'}$config{'catRelDir'}$name: $!"; print $q->redirect($config{'absScriptFile'}.'?mode=admin&encpass=' . $config{'password'}); exit; } } $CGI::DISABLE_UPLOADS = 0; print $q->header(-type=>'text/html'); print $q->start_html(-title=>'Administración de Noticias: Añadir una Categoría de Noticias'); print $q->p($q->h1('Administración de Noticias: Añadir una 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=>'addCategory'); print 'Category Name: (alphanumeric!)

'; print $q->textfield(-name=>'catname', -default=>'', -size=>40, -maxlength=>80); print '

Archivo de imagen para subir:

'; print $q->filefield(-name=>'catimage', -default=>'', -size=>80, -maxlength=>200); print '

'; print $q->submit(-name=>'Add', -Value=>'Add'); print $q->endform; print <<"EOM"; EOM my $url = $config{'absScriptFile'}; my ($protocol, $address) = split('://', $url); $protocol = 'http'; print "
View Category Icons"; print '

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:

'; print $q->textarea(-name=>'newtmpl', -default=>$before, -rows=>10, -columns=>50); print '

HTML a mostrar después de las noticias:

'; print $q->textarea(-name=>'newtmpl2', -default=>$after, -rows=>10, -columns=>50); print '

'; print $q->submit(-name=>'Change', -Value=>'Cambiar'); print $q->endform; print '

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 '

'; print $q->submit(-name=>'Change', -Value=>'Cambiar'); print $q->endform; 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.

"; print $q->submit(-name=>'Confirm', -Value=>'Confirmar'); print '

Volver al Menú Principal'; } print $q->endform; print '

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:

'; my @sortedKeys = sort keys %config; my ($hKey, $hValue); foreach $hKey ( @sortedKeys ) { $hValue = $config{$hKey}; unless ( $hKey eq 'password' || substr($hKey,0,3) eq 'Cat' ) { print $hKey.':
'; print $q->textfield(-name=>'EditKey'.$hKey, -default=>$hValue, -size=>40, -maxlength=>300); print '

'; } } print '
'; print $q->submit(-name=>'Confirm', -Value=>'Confirm'); print $q->endform; print '

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:

'; print $q->submit(-name=>'Delete All', -Value=>'Delete All'); print $q->endform; print '

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 "

"; 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=>'addNews'); print "News headline:
\n"; print $q->textfield(-name=>'head', -default=>'Your headline here!', -size=>100, -maxlength=>200); print "

News text:
\n"; print $q->textarea(-name=>'text', -default=>'Your news here!', -rows=>15, -columns=>80); 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 "

\n"; print $q->submit(-name=>'Add', -Value=>'Add'); print $q->endform; print "

"; print <<"EOM"; EOM my $url = $config{'absScriptFile'}; my ($protocol, $address) = split('://', $url); $protocol = 'http'; print "
View Category Icons"; 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 '
'; print $q->start_Tr(); print '
'; print $q->end_Tr(); print $q->end_table(); # Página html NOTICIA print $q->start_table(); print '
'; print $q->start_Tr(); print $q->start_html(-title=>$lines[$index], -bgcolor=>$config{'popUpBGColor'}, -link=>$config{'popUpLinkColor'}, -vlink=>$config{'popUpLinkColor'}, -alink=>$config{'popUpLinkColor'}); print '

\n"; print ''; print $config{'popUpDateAttributesBegin'}; print $day . ' ' . $config{'month'.$month} . ' ' . $year; print $config{'popUpDateAttributesEnd'}; print ""; print "

\n"; print ''; print $config{'popUpHeadAttributesBegin'}; print '

'; print $lines[$index]; print $config{'popUpHeadAttributesEnd'}; print "
\n"; # Texto de la NOTICIA en el POP-UP print '

'; print ''; if ( substr($lines[$index+4], length($lines[$index+4])-3, 3) eq 'gif' || substr($lines[$index+4], length($lines[$index+4])-3, 3) eq 'jpg') { print ' '; } print ''; print $config{'popUpTextAttributesBegin'}; $lines[$index+2] =~ s/=/=/g; print $lines[$index+2]; print $config{'popUpTextAttributesEnd'}; print $q->end_Tr(); print $q->end_table(); print "
"; # Página html IMPRIMIR print $q->start_table(); print '
'; print $q->start_Tr(); print ''; print '
'; print "Imprimir
"; print $q->end_Tr(); print $q->end_table(); # Página html PIE print $q->start_table(); print '
'; print $q->start_Tr(); print "
\n\n"; print ''; print '
'; print "Cerrar
"; print $q->end_Tr(); print $q->end_table(); print $q->end_html; } __END__