Hello, I have a problem with the Expirator, I need that when hole the field
corresponding to the days is left in that the script expires understands
that that link never expires.
In these moments the script doesn't allow to leave hole the field.
This is the code of the cgi:
# --------------------------------------------------------
eval {
($0 =~ m,(.*)/[^/]+,) && unshift (@INC, "$1"); # Get the script location: UNIX /
($0 =~ m,(.*)\\[^\\]+,) && unshift (@INC, "$1"); # Get the script location: Windows \
require "links.cfg"; # Change this to full path to links.cfg if you have problems.
require "$db_script_path/db_utils.pl";
require "$db_script_path/links.def";
require "$db_script_path/db.pl";
require "$db_script_path/admin_html.pl";
$build_use_templates ?
require "$db_script_path/site_html_templates.pl" :
require "$db_script_path/site_html.pl";
use vars qw(%category %subcategories @links @new_links @cool_links %stats $grand_total $use_html $nph $date $time);
};
if ($@) {
print "HTTP/1.0 200 OK\n";
print "Content-type: text/plain\n\n";
print "Error including libraries: $@\n";
print "Make sure they exist, permissions are set properly, and paths are set correctly.";
exit;
}
# ========================================================
eval { &main; }; # Trap any fatal errors so the program hopefully
if ($@) { &cgierr("fatal error: $@"); } # never produces that nasty 500 server error page.
exit; # There are only two exit calls in the script, here and in in &cgierr.
sub main {
# --------------------------------------------------------
$time = &get_time;
$date = &get_date;
$| = 1; # Must flush output.
$nph = 1;
&html_print_headers;
local($succstr, $errstr);
local(%in) = &parse_form; # Get Form Results
if ($in{'delete_records'} eq "1") {&delete_records;}
elsif ($in{'email_to_expired_records'} eq "1") {&html_email_notification;}
else {&html_expire_form;}
}
sub html_record_form_spreadsheet_expire {
# --------------------------------------------------------
# Displays a record in a one row format
my (%rec) = @_;
my ($font) = qq|Font face="Verdana, Arial, Helvetica" Size=1 Color=#003399|;
print qq|
<td><strong><a href="$build_jump_url?$db_key=$rec{$db_key}">$rec{$db_title}</a></strong>
</td><td>$rec{$db_modified}</td><td>$rec{$db_expiration}</td>
|;
}
sub html_expire_form {
# --------------------------------------------------------
# search for expirated records
my ($message) = @_;
my (@hits, @num_days) = ();
my (@db_form_header_columns_expire) = ("Document", "Added", "Expired", "Days Exp.");
my ($numhits, $maxhits,$days, $i, $totalexp) = 0;
open (DB, "<$db_file_name") or &cgierr("error in records. unable to open db file: $db_file_name. Reason: $!");
@lines = <DB>;
close DB;
LINE: foreach $line (@lines) {
if ($line =~ /^$/) { next LINE; }
if ($line =~ /^#/) { $output .= $line; next LINE; }
chomp ($line);
@rec = &split_decode($line);
$days = &days_old($rec[$db_modified]);
### LDN MODIFY START - Expire for no. of days old instead of by date
if ($rec[$db_expiration]) { # let's check if the link have an expiration field
if (&compare_dates($date, $rec[$db_expiration])){ # if this page is expired add the link to the expire.db
push(@hits, @rec);
push(@num_days, ($days));
$totalexp++;
}
}
### LDN MODIFY END
}
$numhits = $totalexp; #($hits+1) / ($db_cols+1);
$maxhits = $db_max_hits;
$maxhits = $in{'mh'} if ($in{'mh'});
&html_print_headers;
print qq|
<HTML><HEAD>
<TITLE>Expirator.</TITLE>
</HEAD>
<p>Links Manager: Expirator</p>
<H2><TT>Expirator</TT></H2>
<p>Pages checked on $date at $time<br>
--------------------------------------------------------</p><p></p>
<FORM ACTION="$db_dir_url/nph-expirator.cgi" METHOD="GET">
<input type="hidden" name="db" value="$db_name">
|;
print qq|<p><font size=3 color=red>$message</font></font></p>| if ($message ne "");
# Go through each hit and convert the array to hash and send to
# html_record for printing. Also add a checkbox with name=key and value=delete.
if ($numhits < 1) { # search returned 0
print qq|No expired records found.</font>|;
}
else {
# Print Column Headers
if ($numhits == $maxhits) {
print qq|<P>Too much records found on search (<strong>$maxhits</strong> ).
<A HREF="$db_search_next_url">Next $maxhits</a>?|;
}
else {
print qq|<P>There are <strong>$numhits</strong> expired records<p></p>|;
}
print qq| Check records then choose an action and press the "Proceed" button
<TABLE BORDER=1 CELLPADDING=6 CELLSPACING=0><tr><td><strong>$db_key</strong></td>|;
foreach $col (@db_form_header_columns_expire) {
print qq|<td><strong>$col</font></strong></td>|;
}
print "</tr>";
# Print Main Body.
for ($i = 0; $i < $numhits; $i++) {
%tmp = &array_to_hash ($i, @hits);
print qq|<TR><TD valign=top width="50">
<INPUT TYPE=CHECKBOX NAME="$tmp{$db_key}" VALUE="delete">$tmp{$db_key}</font></TD>|;
### LDN MODIFY START -----------------------------------------------------------------
print qq|
<td><strong><a href="$build_jump_url?$db_key=$tmp{$db_key}">$tmp{'Title'}</a></strong>
</td><td>$tmp{'Date'}</td><td>$tmp{'ExpireDays'}</td>
|;
### &html_record_form_spreadsheet_expire (%tmp); # Original Code
### LDN MODIFY END -------------------------------------------------------------------
print qq|
<TD>$num_days[$i]</TD></TR>|;
}
$template_email_body = &load_template ('email-exp.txt', \%tmp);
print qq|</TABLE><P>
<INPUT TYPE="radio" NAME="delete_records" VALUE="1">Delete Selected Records <br>
<INPUT TYPE="radio" NAME="email_to_expired_records" VALUE="1">Email Notification to Selected Records
( <INPUT TYPE="checkbox" NAME ="is_debug" VALUE ="yes" CHECKED>Debug Mode)<br><P>
<table border=0>
<tr><td valign="top">
<INPUT TYPE="SUBMIT" VALUE="Proceed">
<INPUT TYPE="RESET" VALUE="Reset"><p></p></td></tr><tr><td>|;
# <font color=blue>E-mail message will look like:<br><font color=red>Don't make any changes here! To change use <a href="$db_dir_url/admin.cgi?db=links&html_edit_template=1">Edit Templates</a> and edit email-exp.txt</font></font><BR>
# <TEXTAREA NAME="message_to_email_body" ROWS="15" COLS="80" WRAP="VIRTUAL" MAXLENGTH="7000">$template_email_body</TEXTAREA>
# </td></tr>
print qq|</table>
|;
}
print qq|
</FORM></BODY></HTML>|;
}
sub html_email_notification {
# --------------------------------------------------------
# email a notification email to selected people
my (%email_listm, $succstr, $errstr);
my ($line, @lines, $id, @rest, $output, $message_to_email_tmp);
my ($rec_to_email) = 0;
foreach $key (keys %in){ # Build a hash of keys to email.
if ($in{$key} eq "delete"){
$email_list{$key} = 1;
$rec_to_email = 1;
}
}
if (!$rec_to_email) {
&html_expire_form("You must mark at least one record.");
exit;
}
print qq|
<html><head>
<title>Email Notification</title>
</head>
<FONT SIZE=4>Email Notification sent to </FONT></font><BR>
<P>Expirator needs <b>time</b> to finish its work. Please be patient and wait until the program tells you that all e-mails are sent.
<font color=blue>BLUE</font> color tells that the records have been mailed correctly, <font color=red>RED</font> color tells you that
email could not be emailed.</font>
<p>Process started [$date][$time]...<BR>
|;
open (DB, "<$db_file_name") or &cgierr("error in records. unable to open db file: $db_file_name. Reason: $!");
@lines = <DB>;
close DB;
LINE: foreach $line (@lines) {
if ($line =~ /^$/) { next LINE; }
if ($line =~ /^#/) { $output .= $line; next LINE; }
chomp ($line);
(@rec) = &split_decode($line);
%tmp = &array_to_hash (0, @rec);
if ($email_list{$rec[0]}) {
if ($in{'is_debug'} ne "yes")
{ print qq|<font color=blue>$rec[0] ($rec[$db_contact_email])
$rec[$db_contact_name] - $rec[$db_url]</font><BR>
|;
sleep 1 ;
&send_email(%tmp);
}
else {$template_email_body = &load_template('email-exp.txt', \%tmp);
print "<hr><PRE><font color=black SIZE=1>$template_email_body</font></pre>\n\n";
$errstr .= "$rec[0] $rec[1]\n";
}
$succstr .= "$rec[0] $rec[1]\n";
}
}
if ($online) {&send_email_to_admin;
print qq|<hr>Log email sent to the administrator.</font>|;}
print qq|
<p>Completed! [$time]
<p><font color="red"><b>WARNING!</b></font> You could accidentally restart the process and email again!
It is strongly recomended to <B>CLOSE immediately this window</B> to prevent any kind of error.<BR>
If you want to definitely cancel selected records just press the back button and complete the action.
</font>
</BODY></HTML>
|;
}
sub send_email_to_admin {
# --------------------------------------------------------
# Sends an email to the admin, letting him know that there is
# a new link waiting to be validated. No error checking as we don't
# want users to see the informative &cgierr output.
# Check to make sure that there is an admin email address defined.
$db_admin_email or &cgierr("Admin Email Address Not Defined in config file!");
my $to = $db_admin_email;
my $from = $db_admin_email;
my $subject = "Expired Links\n";
my $msg = qq|
EXPIRATOR MAIL LOG
---------------------------------------------
|;
my $msg .= qq|DEBUG MODE WAS ACTIVE - NO MAIL SENT -| if ($in{'is_debug'} eq "yes");
my $msg .= qq|
---------------------------------------------
Expirator Successfully emailed messages to:
---------------------------------------------
$succstr
=============================================
---------------------------------------------
Could not send email to records:
---------------------------------------------
$errstr
=============================================
Remote Host: $ENV{'REMOTE_HOST'}
Completed : [$date] - [$time]
Sincerely,
Links Manager.
|;
# Then mail it away!
require "$db_lib_path/Mailer.pm";
my $mailer = new Mailer ( { smtp => $db_smtp_server,
sendmail => $db_mail_path,
from => $from,
subject => $subject,
to => $to,
msg => $msg,
log => $db_mailer_log
} ) or return;
$mailer->send or return;
}
sub send_email {
# --------------------------------------------------------
# All the link information is stored in %link.
my (%link) = @_;
# Set the to, from, subject and message to send.
my $to = $link{'Contact Email'};
my $from = $db_admin_email;
my $subject = "$your_link_is_expired";
my $msg = &load_template ('email-exp.txt', \%link);
# Then mail it away!
require "$db_data_path/Mailer.pm";
my $mailer = new Mailer ( { smtp => $db_smtp_server,
sendmail => $db_mail_path,
from => $from,
subject => $subject,
to => $to,
msg => $msg,
log => $db_mailer_log
} ) or
&cgierr("Unable to init mailer! Reason: $Mailer::error");
$mailer->send or &cgierr ("Unable to send modification message. Reason: $Mailer::error");
}
Thank you
corresponding to the days is left in that the script expires understands
that that link never expires.
In these moments the script doesn't allow to leave hole the field.
This is the code of the cgi:
Code:
# Required Librariers # --------------------------------------------------------
eval {
($0 =~ m,(.*)/[^/]+,) && unshift (@INC, "$1"); # Get the script location: UNIX /
($0 =~ m,(.*)\\[^\\]+,) && unshift (@INC, "$1"); # Get the script location: Windows \
require "links.cfg"; # Change this to full path to links.cfg if you have problems.
require "$db_script_path/db_utils.pl";
require "$db_script_path/links.def";
require "$db_script_path/db.pl";
require "$db_script_path/admin_html.pl";
$build_use_templates ?
require "$db_script_path/site_html_templates.pl" :
require "$db_script_path/site_html.pl";
use vars qw(%category %subcategories @links @new_links @cool_links %stats $grand_total $use_html $nph $date $time);
};
if ($@) {
print "HTTP/1.0 200 OK\n";
print "Content-type: text/plain\n\n";
print "Error including libraries: $@\n";
print "Make sure they exist, permissions are set properly, and paths are set correctly.";
exit;
}
# ========================================================
eval { &main; }; # Trap any fatal errors so the program hopefully
if ($@) { &cgierr("fatal error: $@"); } # never produces that nasty 500 server error page.
exit; # There are only two exit calls in the script, here and in in &cgierr.
sub main {
# --------------------------------------------------------
$time = &get_time;
$date = &get_date;
$| = 1; # Must flush output.
$nph = 1;
&html_print_headers;
local($succstr, $errstr);
local(%in) = &parse_form; # Get Form Results
if ($in{'delete_records'} eq "1") {&delete_records;}
elsif ($in{'email_to_expired_records'} eq "1") {&html_email_notification;}
else {&html_expire_form;}
}
sub html_record_form_spreadsheet_expire {
# --------------------------------------------------------
# Displays a record in a one row format
my (%rec) = @_;
my ($font) = qq|Font face="Verdana, Arial, Helvetica" Size=1 Color=#003399|;
print qq|
<td><strong><a href="$build_jump_url?$db_key=$rec{$db_key}">$rec{$db_title}</a></strong>
</td><td>$rec{$db_modified}</td><td>$rec{$db_expiration}</td>
|;
}
sub html_expire_form {
# --------------------------------------------------------
# search for expirated records
my ($message) = @_;
my (@hits, @num_days) = ();
my (@db_form_header_columns_expire) = ("Document", "Added", "Expired", "Days Exp.");
my ($numhits, $maxhits,$days, $i, $totalexp) = 0;
open (DB, "<$db_file_name") or &cgierr("error in records. unable to open db file: $db_file_name. Reason: $!");
@lines = <DB>;
close DB;
LINE: foreach $line (@lines) {
if ($line =~ /^$/) { next LINE; }
if ($line =~ /^#/) { $output .= $line; next LINE; }
chomp ($line);
@rec = &split_decode($line);
$days = &days_old($rec[$db_modified]);
### LDN MODIFY START - Expire for no. of days old instead of by date
if ($rec[$db_expiration]) { # let's check if the link have an expiration field
if (&compare_dates($date, $rec[$db_expiration])){ # if this page is expired add the link to the expire.db
push(@hits, @rec);
push(@num_days, ($days));
$totalexp++;
}
}
### LDN MODIFY END
}
$numhits = $totalexp; #($hits+1) / ($db_cols+1);
$maxhits = $db_max_hits;
$maxhits = $in{'mh'} if ($in{'mh'});
&html_print_headers;
print qq|
<HTML><HEAD>
<TITLE>Expirator.</TITLE>
</HEAD>
<p>Links Manager: Expirator</p>
<H2><TT>Expirator</TT></H2>
<p>Pages checked on $date at $time<br>
--------------------------------------------------------</p><p></p>
<FORM ACTION="$db_dir_url/nph-expirator.cgi" METHOD="GET">
<input type="hidden" name="db" value="$db_name">
|;
print qq|<p><font size=3 color=red>$message</font></font></p>| if ($message ne "");
# Go through each hit and convert the array to hash and send to
# html_record for printing. Also add a checkbox with name=key and value=delete.
if ($numhits < 1) { # search returned 0
print qq|No expired records found.</font>|;
}
else {
# Print Column Headers
if ($numhits == $maxhits) {
print qq|<P>Too much records found on search (<strong>$maxhits</strong> ).
<A HREF="$db_search_next_url">Next $maxhits</a>?|;
}
else {
print qq|<P>There are <strong>$numhits</strong> expired records<p></p>|;
}
print qq| Check records then choose an action and press the "Proceed" button
<TABLE BORDER=1 CELLPADDING=6 CELLSPACING=0><tr><td><strong>$db_key</strong></td>|;
foreach $col (@db_form_header_columns_expire) {
print qq|<td><strong>$col</font></strong></td>|;
}
print "</tr>";
# Print Main Body.
for ($i = 0; $i < $numhits; $i++) {
%tmp = &array_to_hash ($i, @hits);
print qq|<TR><TD valign=top width="50">
<INPUT TYPE=CHECKBOX NAME="$tmp{$db_key}" VALUE="delete">$tmp{$db_key}</font></TD>|;
### LDN MODIFY START -----------------------------------------------------------------
print qq|
<td><strong><a href="$build_jump_url?$db_key=$tmp{$db_key}">$tmp{'Title'}</a></strong>
</td><td>$tmp{'Date'}</td><td>$tmp{'ExpireDays'}</td>
|;
### &html_record_form_spreadsheet_expire (%tmp); # Original Code
### LDN MODIFY END -------------------------------------------------------------------
print qq|
<TD>$num_days[$i]</TD></TR>|;
}
$template_email_body = &load_template ('email-exp.txt', \%tmp);
print qq|</TABLE><P>
<INPUT TYPE="radio" NAME="delete_records" VALUE="1">Delete Selected Records <br>
<INPUT TYPE="radio" NAME="email_to_expired_records" VALUE="1">Email Notification to Selected Records
( <INPUT TYPE="checkbox" NAME ="is_debug" VALUE ="yes" CHECKED>Debug Mode)<br><P>
<table border=0>
<tr><td valign="top">
<INPUT TYPE="SUBMIT" VALUE="Proceed">
<INPUT TYPE="RESET" VALUE="Reset"><p></p></td></tr><tr><td>|;
# <font color=blue>E-mail message will look like:<br><font color=red>Don't make any changes here! To change use <a href="$db_dir_url/admin.cgi?db=links&html_edit_template=1">Edit Templates</a> and edit email-exp.txt</font></font><BR>
# <TEXTAREA NAME="message_to_email_body" ROWS="15" COLS="80" WRAP="VIRTUAL" MAXLENGTH="7000">$template_email_body</TEXTAREA>
# </td></tr>
print qq|</table>
|;
}
print qq|
</FORM></BODY></HTML>|;
}
sub html_email_notification {
# --------------------------------------------------------
# email a notification email to selected people
my (%email_listm, $succstr, $errstr);
my ($line, @lines, $id, @rest, $output, $message_to_email_tmp);
my ($rec_to_email) = 0;
foreach $key (keys %in){ # Build a hash of keys to email.
if ($in{$key} eq "delete"){
$email_list{$key} = 1;
$rec_to_email = 1;
}
}
if (!$rec_to_email) {
&html_expire_form("You must mark at least one record.");
exit;
}
print qq|
<html><head>
<title>Email Notification</title>
</head>
<FONT SIZE=4>Email Notification sent to </FONT></font><BR>
<P>Expirator needs <b>time</b> to finish its work. Please be patient and wait until the program tells you that all e-mails are sent.
<font color=blue>BLUE</font> color tells that the records have been mailed correctly, <font color=red>RED</font> color tells you that
email could not be emailed.</font>
<p>Process started [$date][$time]...<BR>
|;
open (DB, "<$db_file_name") or &cgierr("error in records. unable to open db file: $db_file_name. Reason: $!");
@lines = <DB>;
close DB;
LINE: foreach $line (@lines) {
if ($line =~ /^$/) { next LINE; }
if ($line =~ /^#/) { $output .= $line; next LINE; }
chomp ($line);
(@rec) = &split_decode($line);
%tmp = &array_to_hash (0, @rec);
if ($email_list{$rec[0]}) {
if ($in{'is_debug'} ne "yes")
{ print qq|<font color=blue>$rec[0] ($rec[$db_contact_email])
$rec[$db_contact_name] - $rec[$db_url]</font><BR>
|;
sleep 1 ;
&send_email(%tmp);
}
else {$template_email_body = &load_template('email-exp.txt', \%tmp);
print "<hr><PRE><font color=black SIZE=1>$template_email_body</font></pre>\n\n";
$errstr .= "$rec[0] $rec[1]\n";
}
$succstr .= "$rec[0] $rec[1]\n";
}
}
if ($online) {&send_email_to_admin;
print qq|<hr>Log email sent to the administrator.</font>|;}
print qq|
<p>Completed! [$time]
<p><font color="red"><b>WARNING!</b></font> You could accidentally restart the process and email again!
It is strongly recomended to <B>CLOSE immediately this window</B> to prevent any kind of error.<BR>
If you want to definitely cancel selected records just press the back button and complete the action.
</font>
</BODY></HTML>
|;
}
sub send_email_to_admin {
# --------------------------------------------------------
# Sends an email to the admin, letting him know that there is
# a new link waiting to be validated. No error checking as we don't
# want users to see the informative &cgierr output.
# Check to make sure that there is an admin email address defined.
$db_admin_email or &cgierr("Admin Email Address Not Defined in config file!");
my $to = $db_admin_email;
my $from = $db_admin_email;
my $subject = "Expired Links\n";
my $msg = qq|
EXPIRATOR MAIL LOG
---------------------------------------------
|;
my $msg .= qq|DEBUG MODE WAS ACTIVE - NO MAIL SENT -| if ($in{'is_debug'} eq "yes");
my $msg .= qq|
---------------------------------------------
Expirator Successfully emailed messages to:
---------------------------------------------
$succstr
=============================================
---------------------------------------------
Could not send email to records:
---------------------------------------------
$errstr
=============================================
Remote Host: $ENV{'REMOTE_HOST'}
Completed : [$date] - [$time]
Sincerely,
Links Manager.
|;
# Then mail it away!
require "$db_lib_path/Mailer.pm";
my $mailer = new Mailer ( { smtp => $db_smtp_server,
sendmail => $db_mail_path,
from => $from,
subject => $subject,
to => $to,
msg => $msg,
log => $db_mailer_log
} ) or return;
$mailer->send or return;
}
sub send_email {
# --------------------------------------------------------
# All the link information is stored in %link.
my (%link) = @_;
# Set the to, from, subject and message to send.
my $to = $link{'Contact Email'};
my $from = $db_admin_email;
my $subject = "$your_link_is_expired";
my $msg = &load_template ('email-exp.txt', \%link);
# Then mail it away!
require "$db_data_path/Mailer.pm";
my $mailer = new Mailer ( { smtp => $db_smtp_server,
sendmail => $db_mail_path,
from => $from,
subject => $subject,
to => $to,
msg => $msg,
log => $db_mailer_log
} ) or
&cgierr("Unable to init mailer! Reason: $Mailer::error");
$mailer->send or &cgierr ("Unable to send modification message. Reason: $Mailer::error");
}
Thank you