#!/usr/local/bin/perl

#############################################################
# Delete Records 1.0
# delete.cgi
# (C)1999 Anthro TECH, L.L.C
# http://www.anthrotech.com/
#
# Automatically removes entries older than
# a predetermined date. This file can be run via cron or Win Scheduler
# Programs on a daily basis to delete old records. This only works for
# standard DBMAN systems that do NOT include the File Upload
# Mod. This file can also be executed via your web browser.
#
# For information on how to set-up a cron job using this script,
# refer to the following Thread on Gossamer-Threads Support Forum:
#
# http://www.gossamer-threads.com/scripts/forum/resources/Forum12/HTML/000779.html
#
#
# If you have any questions or problems using this script, please post your
# message on the Gossamer Threads Support Forum, which is located at:
#
# http://www.gossamer-threads.com/scripts/forum/
#
# The deletion routines were originally written by Carol, Moderator of
# DBMAN Forums at Gossamer-Threads, and Alex, Owner of Gossamer-Threads.
#
# I just added in some sub-routines that the routine calls from the
# db.cgi file to enhance efficiency of this script.
############################################################################

############################################################################
# INSTRUCTIONS
#
# 1) Make sure that your perl path in the first line is correct.
# 2) Create a field in your default.cfg file called "RemoveAd".
#
# e.g., RemoveAd => [26, 'numer', 4, 5, 1, '', ''],
#
# If you do not have a Date Added Field, then you will have
# to add another field for when the record was added. It
# should look like the following:
#
# DateAdded => [1, 'date', 4, 5, 1, &get_date, ''],
#
# 3) Add this field in your html_record_form in html.pl
#
# Note: You can set a default value for the RemoveAd field
# and then create a hidden field like the following:
#
# <INPUT TYPE="HIDDEN" NAME="RemoveAd" VALUE="90">
#
# 4) Make sure that you have the correct path for your default.cfg
# file in the "require" line.
# 5) Make sure that you have the appropriate Field Numbers for the
# following variables:
#
# $removeby_field
# $dateadded_field
#
# 6) Save this file in your /cgi-bin/ directory under your DBMAN directory.
#
# 7) Change the permission of this file to: 755 or -rwxr-xr-x
#
# Owner : Read, Write, Execute (RWX)
# Group : Read, Execute (RX)
# Everyone: Read, Execute (RX)
#
#############################################################################

# Database Script Path...Same as what is in the db.cgi file

$db_script_path = '/path/to/cgi-bin/dbman';

# Required Files to make this file work.

require "/path/to/default.cfg";

# Change to the correct field number

my $removeby_field = 26;

# Change to the correct field number

my $dateadded_field = 1;

my $today = &date_to_unix(&get_date);
my (@lines, @values);

print "Content-type: text/plain\n\n";
open (DB, $db_script_path/$db_file_name) or ("Can't open: $db_script_path/$db_file_name. Reason: $!");
if ($db_use_flock) {
flock (DB, 1);
}
@lines = <DB>;
close DB;

open (DB, ">$db_script_path/$db_file_name") or ("Can't open: $db_script_path/$db_file_name. Reason: $!");
if ($db_use_flock) {
flock (DB, 2);
}
foreach (@lines) {
next if /^#/;
next if /^\s*$/;
chomp;
@values = &split_decode ($_);
print "Comparing: '$today' vs '$values[$removeby_field]' ... \n";
if ($today > (&date_to_unix($values[$dateadded_field]) + (86400 * $values[$removeby_field]))) {
print "Record(s) Deleted\n";
next;
}
print DB $_, "\n";
}
close DB;

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 ($time1) = $_[0];
($time1) or ($time1 = time());

my ($sec, $min, $hour, $day, $mon, $year, $dweek, $dyear, $daylight) = localtime($time1);
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";
}

sub date_to_unix {
# ------------------------------------------------------
# This routine must take your date format and return the time a la UNIX # time. Some things to be careful about..int your values just in case
# to remove spaces, etc. catch the fatal error timelocal will generate # if you have a bad date..don't forget that the month is indexed from

my ($date) = $_[0];
my (%months) = ("Jan" => 0, "Feb" => 1, "Mar" => 2, "Apr" => 3, "May" => 4, "Jun" => 5,
"Jul" => 6, "Aug" => 7, "Sep" => 8, "Oct" => 9, "Nov" => 10,"Dec" => 11);
my ($time);
my ($day, $mon, $year) = split(/-/, $_[0]);
unless ($day and $mon and $year) { return undef; }
unless (defined($months{$mon})) { return undef; }
use Time::Local;
eval {
$day = int($day); $year = int($year) - 1900;
$time = timelocal(0,0,0,$day, $months{$mon}, $year);
};
if ($@) { return undef; } # Could return 0 if you want.
return ($time);
}

sub split_decode {
# --------------------------------------------------------
# Takes one line of the database as input and returns an
# array of all the values. It replaces special mark up that
# join_encode makes such as replacing the '``' symbol with a
# newline and the '~~' symbol with a database delimeter.

my ($input) = shift;
$input =~ s/\Q$db_delim\E$/$db_delim /o; # Add a space if we have delimiter new line.
my (@array) = split (/\Q$db_delim\E/o, $input);
for ($i = 0; $i <= $#array; $i++) {
$array[$i] =~ s/~~/$db_delim/og; # Retrieve Delimiter..
$array[$i] =~ s/``/\n/g; # Change '' back to newlines..
}
return @array;
}

#!/usr/local/bin/perl
use Socket;
$|=1;

#############################################################
# Stand Alone Mass Email Program, v.1.0 (Beta)
# mailer.cgi
# (C)1999 Anthro TECH, L.L.C
# http://www.anthrotech.com/
#
# If you have any questions or problems using this script, please post your
# message on the Gossamer Threads Support Forum, which is located at:
#
# http://www.gossamer-threads.com/scripts/forum/
#
###############################################################

###############################################################
# ABOUT THIS PROGRAM
#
# This sends mass email messages to Database users based on
# certain fields (such as Year of Graduation, Member of Certain
# Groups, etc.). This program can be executed via your web
# browser or set up as a Cronjob (for UNIX) or scheduled program
# (for NT).
###############################################################

###############################################################
# PROPOSED FUTURE ENHANCEMENTS
#
# 1) Work with DBMAN Template System
# 2) Set up fields in array for sending out more targeted email
# messages to Database users.
# 3) Enhanced Logging functions.
# 4) Web Based Administration to customize messages and choose
# users to send email.
###############################################################

###############################################################
# INSTRUCTIONS
#
# 1) Make sure that you have the proper path to your Perl
# Program in the first line
#
# 2) Set up the appropriate values for variables in the
# Configuration Section of this file.
#
# 3) Save this file as mailer.cgi. It is best to keep
# this file in a password protected directory on your
# web server, so that other people will not be able
# to execute this file.
#
# 4) Change the permissions of this file to 755 or rwxr-xr-x
#
# Translation:
#
# Owner = Read, Write, Execute
# Group = Read, Execute
# Everyone = Read, Execute
#
# While you are not using this file, it is best to change
# the permissions of this file to 444 or r--------.
#
# Translation:
#
# Owner = Read
# Group = Nothing
# Everyone = Nothing
#
# 5) Execute this file via your web browser or Cron/At Scheduler.
# (For information on setting up Cron jobs for UNIX, please
# refer to the following web page:
#
# http://www.gossamer-threads.com/scripts/resources/Detailed/244.html
#
# For NT Systems, please consult your Hosting Company or the
# Microsoft Web Site (www.microsoft.com) for information on
# scheduling applications as services or via the AT Scheduler
# in the NT Resource Kit.)
###############################################################

#############################################################
# CONFIGURATIONS
#############################################################

#############################################################
# Directory path to your where your .db file is located.
# DO NOT PUT A TRAILING SLASH
#
# Example for UNIX:
# /mnt/guide/web/myaccount/cgi-bin/dbman
#
# Example for NT:
# C:/InetPub/wwwroot/myaccount/cgi-bin/dbman
#############################################################

$db_path = "";

#############################################################
# This is the name of your .db file.
# Example: default.db
#############################################################

$db_file_name = "";

#############################################################
# MAIL PROGRAM CONFIGURATIONS
#
#This sub-section is for configuring your sendmail or SMTP
# Configurations. If you are using SMTP, then you must set
# the following variables:
# $smtp = 1;
# require $mailer_path . "/Mailer.pm";
# $mailer_path = "";
# $smtpserver = "mydomain.com";
#
# UNIX Example for $mailer_path (NOTE: No Trailing Slash):
# $mailer_path = "/mnt/guide/web/myaccount/cgi-bin/sendmail";
#
# NT Example for $mailer_path (NOTE: No Trailing Slash):
# $mailer_path = "C:/InetPub/wwwroot/myaccount/cgi-bin/sendmail";
#
# You will also need to download the Mailer.pm module if you
# do not have it on your server. This module can be downloaded
# at perl.com, cpan.com, or gossamer-threads.com.
#
# If you are using Sendmail, then you must set the following
# variables:
# $sendmail = 1;
# $mailprog = "";
#
# UNIX Example for $mailerprog:
# $mailer_path = "|/usr/sbin/sendmail -t -eoq";
#
# NT Example for $mailerprog:
# $mailer_path = "|C:/Winnt/system32/blat.exe -t -eoq";
#
# NOTE: You must set either $sendmail or $smtp to 1 depending
# on which mail program you are using. The other variable you
# are not using, make sure that you set it to 0. Also make sure
# that you rem out (comment out) the other variables you are
# not using by adding a # character to the front of the $ sign.
#############################################################

#############################################################
# SMTP
#############################################################

$smtp = 1;
$mailer_path = "";
require $mailer_path . "/Mailer.pm";
$smtpserver = "mydomain.com";

#############################################################
# SENDMAIL
#############################################################

# $sendmail = 0;
# $mailprog = "";

#############################################################
# SUBJECT OF EMAIL MESSAGE
#
# You will also have to configure the $subject variable,
# which will place a subject in the Email Subject Line.
#
# Example: $subject = 'Newsletter';
#
# This is for BOTH Sendmail and SMTP programs.
#############################################################

$subject = 'INSERT TEXT';

#############################################################
# BODY OF EMAIL MESSAGE
#
# $notify_body_text = '
# Dear Subscribers,
#
# Thank you for subscribing to our email list.';
# This is for BOTH Sendmail and SMTP programs.
#############################################################

$notify_body_text = 'INSERT TEXT';

#############################################################
# ADMINISTRATIVE EMAIL ADDRESS.
#
# Make sure that you have a \ character between the user
# account and @ sign, like the following example:
#
# $admin_mail = "myaccount\@mydomain.com";
#
#############################################################

$admin_mail = "";

#############################################################
# EMAIL FIELD IN DATABASE
#
# This is the number of the Email field in your database file.
# Just put the number of the field before the semi-colon,
# like the following example:
#
# $mailfield = 5;
#
#############################################################

$mailfield = ;

#############################################################
# USER FIELD IN DATABASE
#
# This is the number of the particular field that you want
# to send email messages to. This can be the field of YEAR GRADUATED,
# GROUP OF USERS (like NT Users), etc. Just put the number of the
# field before the semi-colon, like the following:
#
# $userfield = 3;
##############################################################

$userfield = ;

##############################################################
# TIME SENSITIVE FIELDS
#
# The following fields are used for sending out timely reminders.
# The first variable ($modifiedfield) can be the Date field when
# the record was last modified or added.
#
# The second variable ($reminddays) is the number of days that
# you want to send the mass mailings. For this variable, make
# sure that you put a number of days between the single quotes.
#
# In order for this second variable to work and to automate
# this script, you must use Cron for UNIX or Scheduler Program
# for NT. For information on these processes, please consult
# your hosting company or ISP.
#
# Here are examples of how the variables should be set up:
#
# $modifiedfield = 19;
# $reminddays = '42';
#
##############################################################

$modifiedfield = ;
$reminddays = '';

##############################################################
# INSERT HEADER AND FOOTER
#
# This section allows you to insert header and footer files
# into the Bad URL Error page.
#
# Set the following variables to 1 if you want to insert header
# and footer files. If you do not want any header and footer
# files, then set the variables to 0.
#
# Example:
#
# $insert_header = 1;
# $insert_footer = 1;
##############################################################

$insert_header = 1;
$insert_footer = 1;

##############################################################
# HEADER AND FOOTER FILES
#
# The following variables are the directory paths to your
# header and footer files and also the names/extensions of
# your header and footer files. Notice that there is no
# trailing slash for the directory.
#
# Example (for UNIX):
#
# $insert_path = '/mnt/guide/web/myaccount/files';
# $header = 'header.htm';
# $footer = 'footer.htm';
#
# Example (for NT):
#
# $insert_path = 'C:/InetPub/wwwroot/myaccount/files';
# $header = 'header.htm';
# $footer = 'footer.htm';
#
##############################################################

$insert_path = '';
$header = '';
$footer = '';

##############################################################
# FILE FLOCKING
#
# Set this to 1 if your server allows flocking. If your server
# does not allow flocking, then set it to 0.
##############################################################

$db_use_flock = 1;

##############################################################
# DOMAIN REFERRERS
#
# This allows you to specifies domains that can use this
# script.
#
# Example:
# @referers = ('www.mydomain.com','member.mydomain.com','mydomain.com');
##############################################################

@referers = ('');

#############################################################
# End Configurations
#############################################################

##############################################################
# Begin Script
#############################################################

&Check_URL;

#############################################################
# Open the Database
#############################################################

my $today = &date_to_unix(&get_date);
my (@lines, @data);

open (DB, "<$db_path/$db_file_name") or &cgierr("unable to open password file. Reason: $!\n");
if ($db_use_flock) {
flock(DB, 2);
}
@lines = <DB>;
close DB;

#############################################################
# Start Loop
#############################################################

foreach $line (@lines) {
chomp $line;
@data = split /\|/, $line;
if ($today > (&date_to_unix($data[$modifiedfield]) + (86400 * $reminddays))) {
if ($data[$mailfield] && $data[$userfield]) {
push (@emails,$data[$mailfield]);
push (@users,$data[$userfield]);
}
}
}
if (!$emails[0]) {
print "Content-type: text/html\n\n";
print "No Email Address or User Name defined in $db_path/$db_file_name!<P>";
print "Messages NOT sent!";
exit;
}

# if you want to print out the email addresses to the browser, add the following:
else {
print "Content-type: text/html\n\n";
foreach $email (@emails) {
print "$email<BR>";
}
}

#############################################################
# Mail Routine
#############################################################

if ($smtp) {
foreach $email (@emails) {
my $mailer = new Mailer ( { smtp => '$smtpserver' } )
or die "Can't init mailer: $Mailer::error";
$mailer->send ( {
to => $email,
from => $admin_mail,
subject => "$subject",
msg => $notify_body_text
} )
or die "Can't send mail: $Mailer::error";
}
}
if ($sendmail) {
foreach $email (@emails) {
open (MAIL, "$mailprog") or &cgierr("unable to open mail program");
print MAIL "To: $email\n";
print MAIL "From: $admin_mail\n";
print MAIL "Subject: $subject\n";
print MAIL "$notify_body_text\n";
close (MAIL);
}
}

##################################################################
# END SCRIPT
##################################################################

##################################################################
# SUB ROUTINES FOR SCRIPT
##################################################################

sub Check_URL {
##################################################################
# Check Referring URL
##################################################################

if ($ENV{'HTTP_REFERER'}) {
foreach $referer (@referers) {
if ($ENV{'HTTP_REFERER'} =~ /$referer/i) {
$check_referer = '1';
last;
}
}
}
else {
$check_referer = '1';
}

if ($check_referer != 1) {
&error('bad_referer');
}

}

##############################################################
# BAD REQUESTS ERROR MESSAGE #
# -----------------------------------------------------------#
# This error message will appear in the web browser if there #
# is a bad request. #
##############################################################

sub error {

($error,@error_fields) = @_;

print "Content-type: text/html\n\n";

if ($error eq 'bad_referer') {
print "<html><head><title>Bad Referrer - Access Denied</title></head>";
print " <body bgcolor=\"ffffff\">";
if ($insert_header) {
print &header_file;
}
print "<div align=\"center\"><center>";
print "<table border=\"0\" width=\"600\" cellpadding=\"2\" cellspacing=\"0\">";
print "<tr><td valign=\"top\">";
print "<font face=\"Arial\" size=\"4\"><b>Bad Referrer - Access Denied</font></b>";
print "<p><font face=\"Verdana\" size=\"2\">";
print "The form that is trying to use this script that";
print "resides at: <a href=\"$ENV{'HTTP_REFERER'}\">$ENV{'HTTP_REFERER'}</a>, is NOT allowed to access this cgi script.";
print "<p><b>Sorry!</b>";
print "<p>Please contact the <a href=\"mailto:$admin_email\">Webmaster</a> about this error immediately. ";
print "Please provide the web page address where you were trying to access this script.";
print "</font></td></tr></table></div></center>";
if ($insert_footer) {
print &footer_file;
}
print "</body></html>\n";
}
exit;
}

# This prints out header file that is inserted into web pages.
#
sub header_file {
# ---------------------------------------------
# Displays the number of accounts

open (INC, "$insert_path/$header") or return "Can't find include file: $patterns{'Other'}";
return join ("", <INC> );
}

sub footer_file {
# ---------------------------------------------
# Displays the number of accounts

open (INC, "$insert_path/$footer") or return "Can't find include file: $patterns{'Other'}";
return join ("", <INC> );
}

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 ($time1) = $_[0];
($time1) or ($time1 = time());

my ($sec, $min, $hour, $day, $mon, $year, $dweek, $dyear, $daylight) = localtime($time1);
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";
}

sub date_to_unix {
# ------------------------------------------------------
# This routine must take your date format and return the time a la UNIX # time. Some things to be careful about..int your values just in case
# to remove spaces, etc. catch the fatal error timelocal will generate # if you have a bad date..don't forget that the month is indexed from

my ($date) = $_[0];
my (%months) = ("Jan" => 0, "Feb" => 1, "Mar" => 2, "Apr" => 3, "May" => 4, "Jun" => 5,
"Jul" => 6, "Aug" => 7, "Sep" => 8, "Oct" => 9, "Nov" => 10,"Dec" => 11);
my ($time);
my ($day, $mon, $year) = split(/-/, $_[0]);
unless ($day and $mon and $year) { return undef; }
unless (defined($months{$mon})) { return undef; }
use Time::Local;
eval {
$day = int($day); $year = int($year) - 1900;
$time = timelocal(0,0,0,$day, $months{$mon}, $year);
};
if ($@) { return undef; } # Could return 0 if you want.
return ($time);
}

sub cgierr {
# --------------------------------------------------------
# Displays any errors and prints out FORM and ENVIRONMENT
# information. Useful for debugging.

if (!$html_headers_printed) {
print "Content-type: text/html\n\n";
$html_headers_printed = 1;
}
print "<PRE>\n\nCGI ERROR\n==========================================\n";
$_[0] and print "Error Message : $_[0]\n";
$0 and print "Script Location : $0\n";
$] and print "Perl Version : $]\n";
$db_setup and print "Setup File : $db_setup.cfg\n";
$db_userid and print "User ID : $db_userid\n";
$db_uid and print "Session ID : $db_uid\n";

print "\nForm Variables\n-------------------------------------------\n";
foreach $key (sort keys %in) {
my $space = " " x (20 - length($key));
print "$key$space: $in{$key}\n";
}
print "\nEnvironment Variables\n-------------------------------------------\n";
foreach $env (sort keys %ENV) {
my $space = " " x (20 - length($env));
print "$env$space: $ENV{$env}\n";
}
print "\n</PRE>";
exit -1;
}

################################################################################
# #
# MULTIPLE SELECT MOD v.2.0 #
# #
# --------------------------------------------------------------- #
# Multiple Select Mod for Adding, Modifying, and Deleting Records #
# --------------------------------------------------------------- #
# This Mod allows you to create drop-down menus for selecting multiple values #
# for fields in your database. This version also works for search forms in #
# your databases. #
# #
# #
# Co-written by Eliot Lee and Carol Hall (JPDeni, DBMAN Forum Moderator). #
# #
# For technical assistance, please post messages in the DBMAN Discussion Forum#
# #
# http://www.gossamer-threads.com/scripts/forum/ #
################################################################################


(1) Add the following sub-routine to your html.pl file:

===============================================================================================

sub build_fancy_mult_field {
# --------------------------------------------------------
#
# To call this subroutine from html_record_form, use the following syntax:
#
# print &build_fancy_mult_field("FieldName",$rec{'FieldName'});
#
# Be sure to express the field name *exactly* as it is defined in your .cfg file.
#
$size = "5";
my $field = $_[0];
my $compare = $_[1];
my %selector = (
'FieldName1' => [
['---','Choose as many that apply:'],
['Value1','Value1'],
['Value2','Value2'],
['Value3','Value3'],
['Value4','Value4'],
['Value5','Value5'],
],
'FieldName2' => [
['---','Choose as many that apply:'],
['Value1','Value1'],
['Value2','Value2'],
['Value3','Value3'],
['Value4','Value4'],
['Value5','Value5'],
],
);

$output = qq|<SELECT NAME="$field" MULTIPLE SIZE="$size">\n|;
$i = 0;
while ( $selector{$field}[$i][0] ) {
$compare =~/$selector{$field}[$i][0]/ ?
($output .= qq|<OPTION VALUE="$selector{$field}[$i][0]" SELECTED>$selector{$field}[$i][1]\n|) :
($output .= qq|<OPTION VALUE="$selector{$field}[$i][0]">$selector{$field}[$i][1]\n|);
++$i;
}
if ($i) {
$output .= "</SELECT>";
}
else {
$output = "Incorrect field definition";
}
return $output;
}

===============================================================================================

NOTE: You will have to make the following changes to this sub-routine:

1. Change FieldName1 and FieldName2 to the field names that you want to have this
multiple selection drop-down menu.

2. Change the "Value*" to the values of your fields.

3. Change the value of $size variable to the number of rows that you want to
appear in the drop-down menu. It should look like the following:

$size = "5";

Replace the number between the double quotes.

(2) Add the following codes to the following sub-routines in your html.pl file:
sub html_record_form, sub html_record, and/or sub html_html_record_long.


print &build_fancy_mult_field("FieldName",$rec{'FieldName'});


NOTE: Replace FieldName with the field name that you defined in the sub build_fancy_mult_field
routine.

(3) Replace the following codes in your sub query routine in the db.cgi file:

my ($i, $column, @search_fields, @search_gt_fields, @search_lt_fields, $maxhits, $numhits, $nh,
$field, @regexp, $line, @values, $key_match, @hits, @sortedhits, $next_url, $next_hit, $prev_hit,
$first, $last, $upper, $lower, $left, $right, $restricted);

with the following codes:

my ($i, $column, @search_fields, @search_gt_fields, @search_lt_fields, $maxhits, $numhits, $nh,
$field, @regexp, $line, @values, $key_match, @hits, @sortedhits, $next_url, $next_hit, $prev_hit,
$first, $last, $upper, $lower, $left, $right, $restricted, $key);

(4) Add the following codes in your sub query routine in the db.cgi file:

foreach $key (keys %in) {
if ($in{$key} =~ /~~/) {
$in{$key} =~ s/~~/|/g;
$in{'re'} = 1;
}
}

AFTER the following codes:

local (%sortby);

(5) Add the following codes in your sub html_record routine or search form
routine in the html.pl file:

|; print &build_fancy_mult_field("FieldName",$rec{'FieldName'}); print qq|

Replace FieldName with the name of your multiple select field name.

Note: You also might want to add hints in your search form, like the
following:

"To choose multiple options, hold your Ctrl key and mouse button."

#!/usr/local/bin/perl

#############################################################
# Number of Records v1.0
# records.cgi
# (C)1999 Anthro TECH, L.L.C
# http://www.anthrotech.com/
#
# Will put a number of categories and sub-categories on
# a static web page.
#
# For technical assistance, please post messages in the DBMAN Discussion Forum
#
# http://www.gossamer-threads.com/scripts/forum/
############################################################################

############################################################################
# INSTRUCTIONS
#
# 1) Make sure that your perl path in the first line is correct.
#
# 2) Make sure that you have the correct path for your default.cfg
# file in the "require" line.
#
# 3) Save this file in your /cgi-bin/ directory under your DBMAN directory.
#
# 4) Change the permission of this file to: 755 or -rwxr-xr-x
#
# Owner : Read, Write, Execute (RWX)
# Group : Read, Execute (RX)
# Everyone: Read, Execute (RX)
#
# 5) This script is called via Server Side Includes (SSI) with the
# following codes in a file (.shtml or .html) that can have SSI:
#
# <!--#exec cgi="/cgi-bin/dbman/records.cgi"-->
#
#############################################################################

# Field Name to List (like Categories or Types)
$cat_name = 'Category';

# DB Setup ....
# Change the db_setup variable to your db name
# Set this to the same as you have in db.cgi
$db_setup = 'default';

# UID Setup....
# Set this up to the uid variable in your db.cgi file
# Should be set as default to allow anyone to view records in this
# Category.
$db_uid = 'default';

# Database script path..Same as what is in the db.cgi file

$db_script_path = '/path/to/cgi-bin/dbman';

# Required Files to make this file work.
require "/path/to/default.cfg";

# Script Link URL
$db_script_link_url = "$db_script_url?db=$db_setup&uid=$db_uid";

print "Content-type: text/html\n\n";

for ($i = 0; $i <= $#db_cols; $i++) {
if ($db_cols[$i] eq "$cat_name") {
$fieldnum = $i; $found = 1;
last;
}
}
if (!$found) {
&cgierr("No $cat_name field defined");
}
open (DB, "<$db_script_path/$db_file_name") or &cgierr("unable to open $db_file_name. Reason: $!");
if ($db_use_flock) {
flock(DB, 1);
}
LINE: while (<DB> ) {
next if /^#/;
next if /^\s*$/;
$line = $_;
chomp ($line);
@fields = &split_decode ($line);
@values = split (/\Q$db_delim\E/o, $fields[$fieldnum]);
foreach $value (@values) {
if (!(grep $_ eq $value, @selectfields)) {
push (@selectfields, $value);
}
++$count{$value};
}
}
close DB;

foreach $field (sort @selectfields) {
$sfield = &urlencode($field);
print qq|<$font><a href="$db_script_link_url&$&view_records=1&ID=*&$cat_name=$sfield&sb=1&so=descend">$field</a>:</font> <$smfont>(<font color="ff0000">$count{$field}</font> )</font><BR>|;
}

sub join_encode {
# --------------------------------------------------------
# Takes a hash (ususally from the form input) and builds one
# line to output into the database. It changes all occurrences
# of the database delimeter to '~~' and all newline chars to '``'.

my %hash = @_;
my ($tmp, $col, $output);

foreach $col (@db_cols) {
$tmp = $hash{$col};
$tmp =~ s/^\s+//g; # Trim leading blanks...
$tmp =~ s/\s+$//g; # Trim trailing blanks...
$tmp =~ s/\Q$db_delim\E/~~/og; # Change delimeter to ~~ symbol.
$tmp =~ s/\n/``/g; # Change newline to `` symbol.
$tmp =~ s/\r//g; # Remove Windows linefeed character.
$output .= $tmp . $db_delim; # Build Output.
}
chop $output; # remove extra delimeter.
$output .= "\n"; # add linefeed char.
return $output;
}

sub split_decode {
# --------------------------------------------------------
# Takes one line of the database as input and returns an
# array of all the values. It replaces special mark up that
# join_encode makes such as replacing the '``' symbol with a
# newline and the '~~' symbol with a database delimeter.

my ($input) = shift;
my (@array) = split (/\Q$db_delim\E/o, $input, $#db_cols+1);
foreach (@array) {
s/~~/$db_delim/g; # Retrieve Delimiter..
s/``/\n/g; # Change '' back to newlines..
}
return @array;
}

sub urlencode {
# --------------------------------------------------------
my($toencode) = @_;
$toencode=~s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
$toencode=~s/\%2F/\//g;
return $toencode;
}


sub array_to_hash {
# --------------------------------------------------------
# Converts an array to a hash using db_cols as the field names.
#
my ($hit, @array) = @_;
my ($i);
return map { $db_cols[$i] => $array[$hit * ($#db_cols+1) + $i++] } @_;
}


sub cgierr {
# --------------------------------------------------------
# Displays any errors and prints out FORM and ENVIRONMENT
# information. Useful for debugging.

if (!$html_headers_printed) {
print "Content-type: text/html\n\n";
$html_headers_printed = 1;
}
print "<PRE>\n\nCGI ERROR\n==========================================\n";
$_[0] and print "Error Message : $_[0]\n";
$0 and print "Script Location : $0\n";
$] and print "Perl Version : $]\n";
$db_setup and print "Setup File : $db_setup.cfg\n";
$db_userid and print "User ID : $db_userid\n";
$db_uid and print "Session ID : $db_uid\n";

print "\nForm Variables\n-------------------------------------------\n";
foreach $key (sort keys %in) {
my $space = " " x (20 - length($key));
print "$key$space: $in{$key}\n";
}
print "\nEnvironment Variables\n-------------------------------------------\n";
foreach $env (sort keys %ENV) {
my $space = " " x (20 - length($env));
print "$env$space: $ENV{$env}\n";
}
print "\n</PRE>";
exit -1;
}

#!/usr/local/bin/perl

#############################################################
# Upgrade your Database v.1.0
# upgrade.cgi
# (C)1999 Anthro TECH, L.L.C
# http://www.anthrotech.com/
#
# For technical assistance, please post messages in the DBMAN Discussion Forum
#
# http://www.gossamer-threads.com/scripts/forum/
##############################################################

##############################################################
# IMPORTANT NOTES
#
# You may have to change the perl path in the first line
# depending on the location of your perl program.
#
# You must EDIT YOUR default.cfg script BEFORE entering these
# variable and running this script!
#
# Save this file as 'upgrade.cgi' or 'upgrade.pl' depending
# on the appropriate extension your ISP allows for executable
# Perl files.
#
# Change permissions of this file to 755 or (rwxr-xr-x), which means:
#
# Owner : Read, Write, Execute (RWX)
# Group : Read, Execute (RX)
# Everyone: Read, Execute (RX)
###############################################################


###############################################################
# INSTRUCTIONS
#
# 1) Make sure that you have the proper path to your Perl
# Program in the first line
#
# 2) In the Configuration Section, put in the appropriate
# values for the following:
#
# a) $field_default
# b) $new_field
# c) $total_fields
# d) require "default.cfg";
# e) $db_file_name2
#
# 3) Save this file as upgrade.cgi and place it temporarily
# in your DBMAN directory. DO NOT KEEP THIS FILE ON
# YOUR SERVER. IF SOMEONE EXECUTES IT, IT WILL CLEAR
# THE VALUES IN YOUR NEW FIELD.
#
# 4) Change the permissions of this file to 755 or rwxr-xr-x
#
# Translation:
#
# Owner = Read, Write, Execute
# Group = Read, Execute
# Everyone = Read, Execute
#
# 5) Execute this file via your web browser.
###############################################################

###############################################################
# Configuration Section
###############################################################

#Put the default value of the new field here. Leave Blank for no default.
$field_default = "";

#Put the new field number here.
$new_field = "";

#Put the last field number here.
$total_fields = "";

# Database path...same as in db.cgi file

$db_script_path = '/path/to/cgi-bin/dbman';

#Change these value to match your settings
#You may have to use the absolute path to your .cfg and .cgi file

require "/path/to/default.cfg";

#Rename database file
#You may have to use the absolute path to your second database file

$db_file_name2 = "/path/to/default2.db";

#############################################
#You shouldn't have to edit below this line
#------------------------------------------

$nfm1 = $new_field - 1;
$ENV{'REQUEST_METHOD'} and (print "Content-type: text/plain\n\n");
open (DB, "<$db_script_path/$db_file_name") or print "Unable to open links database '$db_script_path/$db_file_name'. Reason: $!" and exit;
print "\tOpening output file . . .\n\n";
open (DBOUT, ">$db_script_path/$db_file_name2") or print "Unable to open $db_script_path/$db_file_name2. Make sure data dir is chmod 777 temporarily. Reason: $!" and exit;
print "\n\n\tProcessing records...\n\n";
while (<DB> ) {
(/^#/) and next LINE; # Skip comment Lines.
(/^\s*$/) and next LINE; # Skip blank lines.
chomp; # Remove trailing new line.
@rec_in = &split_decode($_);


# Copy fields into second database.

for $i (0 .. $nfm1) {
$rec_out[$i] = $rec_in[$i];
}

# Add New Field

$rec_out[$new_field] = "$field_default";

# Copy the rest of old database file to new database file

for $i ($new_field .. $total_fields) {
$rec_out[$i + 1] = $rec_in[$i];
}
print DBOUT &join_encode(&array_to_hash(0, @rec_out));
}
print "\tDone...\n\n";

close DB;
close DBOUT;

print "\n\n";
print "Database saved it as $db_file_name2.\n";
print "Change permissions back to 755 on the data directory.\n\n";
print "You must rename '$db_file_name' to '$db_file_name2' to '$db_file_name' before using with DBMAN.\n";
print "It is recommend you save the original '$db_file_name' before renaming.\n\n";
print "Make sure that your new database is changed to 666.\n\n";

sub join_encode {
# --------------------------------------------------------
# Takes a hash (ususally from the form input) and builds one
# line to output into the database. It changes all occurrences
# of the database delimeter to '~~' and all newline chars to '``'.

my %hash = @_;
my ($tmp, $col, $output);

foreach $col (@db_cols) {
$tmp = $hash{$col};
$tmp =~ s/^\s+//g; # Trim leading blanks...
$tmp =~ s/\s+$//g; # Trim trailing blanks...
$tmp =~ s/\Q$db_delim\E/~~/og; # Change delimeter to ~~ symbol.
$tmp =~ s/\n/``/g; # Change newline to `` symbol.
$tmp =~ s/\r//g; # Remove Windows linefeed character.
$output .= $tmp . $db_delim; # Build Output.
}
chop $output; # remove extra delimeter.
$output .= "\n"; # add linefeed char.
return $output;
}

sub split_decode {
# --------------------------------------------------------
# Takes one line of the database as input and returns an
# array of all the values. It replaces special mark up that
# join_encode makes such as replacing the '``' symbol with a
# newline and the '~~' symbol with a database delimeter.

my ($input) = shift;
my (@array) = split (/\Q$db_delim\E/o, $input, $#db_cols+1);
foreach (@array) {
s/~~/$db_delim/g; # Retrieve Delimiter..
s/``/\n/g; # Change '' back to newlines..
}
return @array;
}

sub array_to_hash {
# --------------------------------------------------------
# Converts an array to a hash using db_cols as the field names.
#
my ($hit, @array) = @_;
my ($i);
return map { $db_cols[$i] => $array[$hit * ($#db_cols+1) + $i++] } @_;
}