Yes, you could do it.
It would require creating a subroutine that would automatically do a search, collect the old records and then delete them from the current database and add them to the archive.
This is all off the top of my head, so I'm not promising anything. Read carefully the bolded parts of the code below. You'll need to make some changes based on your database.
Code:
sub archive_records {
#--------------------------------------
my ($days,$output,$archive,$fieldnum,$arch_num);
$days = 30; #
Change this to the age of the records you want archived $term = &get_date(time() - ($days * 86400));
$db_archive_file_name = $db_script_path . "/
archive.db"; #
Change the the name of your archive file $fieldnum =
3; #
Change to the number of the field that holds the date the record was added open (DB, "<$db_file_name") or &cgierr("error in search.
unable to open database: $db_file_name.\nReason: $!");
if ($db_use_flock) { flock(DB, 1); }
LINE: while (<DB> ) {
(/^#/) and next LINE; # Skip comment Lines.
(/^\s*$/) and next LINE; # Skip blank lines.
$line = $_;
chomp ($line); # Remove trailing new line.
@values = &split_decode($line);
if (&date_to_unix($values[$fieldnum]) < &date_to_unix($term)) {
$archive .= "$line\n";
++$arch_num;
}
else {
$output .= "$line\n";
}
}
close DB;
open (DB, ">$db_file_name") or &cgierr("error in archive_records.
unable to open db file: $db_file_name.\nReason: $!");
if ($db_use_flock) {
flock(DB, 2) or &cgierr("unable to get exclusive lock on $db_file_name.\nReason: $!");
}
print DB $output;
close DB; # automatically removes file lock
open (DB, ">>$db_archive_file_name") or &cgierr("error in add_record.
unable to open database: $db_archive_file_name.\nReason: $!");
if ($db_use_flock) {
flock(DB, 2) or &cgierr("unable to get exclusive lock on $db_archive_file_name.\nReason: $!");
}
print DB $archive;
close DB; # automatically removes file lock
&html_home($arch_num);
}
This assumes that there will not be a duplicate key that will be added to the archive database. I would only use this if the key for your main database is a numeric key that is tracked by DBMan.
You'll also need to add a line to db.cgi, sub main
Code:
elsif ($in{'archive_records'}) { if ($per_admin) { &archive_records; } else { &html_unauth; } }
And you'll need a link on your home page (probably) like this:
print qq!<a href="$script_link_url&archive_records=1">Archive old records</a> ! if ($per_admin);
And, if you want to have the number of archived records listed on your home page, you'll need to add to sub html_home, right at the beginning
$message = $_[0];
and somewhere outside of a print statement
Code:
if ($message) {
print "There were $message records archived.";
}
Now, before you do anything,
make backups of ALL your files. I haven't tested this, aside from testing for syntax errors. I ain't gonna guarantee nuthin'!
One other thing. You need to have adjusted the get_date subroutine so that it will accept input. Just to be on the safe side, I'll post the subroutine here.
Code:
sub get_date {
# --------------------------------------------------------
# Returns the date in the format "dd-mmm-yyyy".
# Warning: If you change the default format, you must also modify the &date_to_unix
# subroutine below which converts your date format into a unix time in seconds for sorting
# purposes.
my ($time) = $_[0];
($time) or ($time = time());
my ($sec, $min, $hour, $day, $mon, $year, $dweek, $dyear, $daylight) = localtime($time);
my (@months) = qw!Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec!;
($day < 10) and ($day = "0$day");
$year = $year + 1900;
return "$day-$months[$mon]-$year";
}
------------------
JPD
[This message has been edited by JPDeni (edited June 02, 1999).]
