misc/nielsen/Test/ 0040775 0000765 0000765 00000000000 07352355256 013067 5 ustar mark mark misc/nielsen/Test/Docs/ 0040775 0000765 0000765 00000000000 07352362555 013757 5 ustar mark mark misc/nielsen/Test/Docs/SDS.txt 0100664 0000765 0000765 00000013265 07352362555 015155 0 ustar mark mark Standard Database Setup (SDS) version 1.0.
Copyright by Mark Nielsen, 9/2001.
1. All tables must contain the following:
a. A primary key equal to TABLENAME_id.
b. Timestamps for the date of creation and modification, date_created
and date_updated.
c. There will be a backup table named TABLENAME_backup.
d. All fields are lower case.
e. An active field whose status of 0 is inactive and 1 is active.
f. All foreign keys must have the extension "_fk" except for fieldnames
ending in "_id".
g. All fieldnames with "_id" in the table definition will automatically
get a foreign keys constraint. A fieldname of "TABLENAME_id" will
have a foreign constraint to the table "TABLENAME" with its primary key
"TABLENAME_id".
h. Views for active, inactive (deleted), and purged will be created.
i. Insert, Update, Delete, Copy, Change, Purge, Unpurge, PurgeOne,
and UnpurgeOne functions are too be used for all database
modifications where the functions will be
named "TABLENAME_FUNCTION_sql".
j. When stored procedures can return multiple variables, then all
select statements will be executed through stored procedures as well.
All select stored procedures will end in "_select_sql".
The two types of select stored procedures will be:
1. Given a unique id number, the select statement will require
all fields for that row. This stored procedures will be named
"TABLENAME_select_sql".
2. All other select statements will be custom made. Select statements
can get very complicated. It is mandatory that all custom select
statements be created with custom stored procedures.
k. All modifications to any table will be recorded in "TABLENAME_backup".
Modifications will occur through standard stored procedures and
the stored procedures will handle recording of these modifications.
"backup_id" will the primary key of all backup tables.
l. All selects of tables will be recorded as an option using the table
"TABLENAME_select" if it is desired when the table is created.
"TABLENAME_select" will have the fields select_id, date_created,
date_updated, TABLENAME_id, error_code, and misc.
m. An optional method for recording database inserts and changes
with respect to differences may be used, but must follow the following
standards. This will not be included by default in MAPPS.
1. The backup table must be named TABLENAME_diff.
2. "diff_id" will be the primary key for each table.
3. Each diff table will have exactly these fields.
a. diff_id
b. date_updated : Timestamp the data was entered.
c. diff_data : This is the difference in data between this
entry and the previous entry.
d. diff_method : This describes the difference method used.
This is arbitrary and dependent upon the programmer. Here are
a list of pre-defined methods:
1. "diff" or "gnudiff" will correspond to GNU diff. The version
must be supplied and recorded somewhere.
2. "subversion" in relation to subversion.
3. cvs will not be an option for a standard. "subversion" replaces
cvs, and hence, by the time SDS is really solid, subversion
from subversion.org will be ready.
e. diff_prev : This is the previous diff_id which the data is
being compared to. This is done so that if a diff_id gets
deleted, you can state there is an error.
f. fieldname : This is the field of the row which the data
belongs to.
g. primary : This is the primary key of the row we are looking at.
h. error_code : "start" means there is no diff_id previous
to this one. "diff" means there is a previous entry to
be compared to. "stop" means the primary key has been deleted.
Other error codes are possible.
n. An entry of 0 into a foreign key means null. All rows with a primary
key of 0 should have empty space for text and 0 for numeric values
or the default value (if supplied).
2. The unique names which cannot be used are:
a. "error_code", "backup_id", "date_created", "date_updated",
, "diff_id" and "active" are reserved fields.
3. Standard practices with Perl Modules and other programming languages.
a. All Perl Modules (or other programming languages) will create
objects whose methods correspond to each stored procedure. The naming
convention of each method shall be exactly the sql function name minus
the tablename and "_sql". Thus, "TABLENAME_FUNCTION_sql" becomes
"FUNCTION" in the Perl Module. There will be an exact one to one
correspondence between all sql functions and perl methods, minus
custom made sql functions or perl methods.
b. All custom made perl methods must use stored procedures for all
changing of data, and selecting data (when stored procedures
can return multiple variables).
4. Standard practices of custom stored procedures.
a. All custom stored procedures may only change data using one of the
predefined stored procedures. Custom stored procedures may not
use custom made stored procedures for changing/inserting data.
b. All select statements must use select stored procedures (when the
stored procedures can return multiple values).
5. Standard practices of webpages/perl scripts.
a. All perl scripts or other programming languages will always
use perl modules for all interactivity with database. All changing,
inserting, or viewing data will occur through a module.
misc/nielsen/Test/Docs/SDS.txt~ 0100664 0000765 0000765 00000013266 07352357143 015351 0 ustar mark mark Standard Database Setup (SDS) version 1.0.
Copyright by Mark Nielsen, 9/2001.
1. All tables must contain the following:
a. A primary key equal to TABLENAME_id.
b. Timestamps for the date of creation and modification, date_created
and date_updated.
c. There will be a backup table named TABLENAME_backup.
d. All fields are lower case.
e. An active field whose status of 0 is inactive and 1 is active.
f. All foreigns keys must have the extension "_fk" except for fieldnames
ending in "_id".
g. All fieldnames with "_id" in the table definition will automatically
get a foreign keys constraint. A fieldname of "TABLENAME_id" will
have a foreign constraint to the table "TABLENAME" with its primary key
"TABLENAME_id".
h. Views for active, inactive (deleted), and purged will be created.
i. Insert, Update, Delete, Copy, Change, Purge, Unpurge, PurgeOne,
and UnpurgeOne functions are too be used for all database
modifications where the functions will be
named "TABLENAME_FUNCTION_sql".
j. When stored procedures can return multiple variables, then all
select statements will be executed through stored procedures as well.
All select stored procedures will end in "_select_sql".
The two types of select stored procedures will be:
1. Given a unique id number, the select statement will require
all fields for that row. This stored procedures will be named
"TABLENAME_select_sql".
2. All other select statements will be custom made. Select statements
can get very complicated. It is mandatory that all custom select
statements be created with custom stored procedures.
k. All modifications to any table will be recorded in "TABLENAME_backup".
Modifications will occur through standard stored procedures and
the stored procedures will handle recording of these modifications.
"backup_id" will the primary key of all backup tables.
l. All selects of tables will be recorded as an option using the table
"TABLENAME_select" if it is desired when the table is created.
"TABLENAME_select" will have the fields select_id, date_created,
date_updated, TABLENAME_id, error_code, and misc.
m. An optional method for recording database inserts and changes
with respect to differences may be used, but must follow the following
standards. This will not be included by default in MAPPS.
1. The backup table must be named TABLENAME_diff.
2. "diff_id" will be the primary key for each table.
3. Each diff table will have exactly these fields.
a. diff_id
b. date_updated : Timestamp the data was entered.
c. diff_data : This is the difference in data between this
entry and the previous entry.
d. diff_method : This describes the difference method used.
This is arbitrary and dependent upon the programmer. Here are
a list of pre-defined methods:
1. "diff" or "gnudiff" will correspond to GNU diff. The version
must be supplied and recorded somewhere.
2. "subversion" in relation to subversion.
3. cvs will not be an option for a standard. "subversion" replaces
cvs, and hence, by the time SDS is really solid, subversion
from subversion.org will be ready.
e. diff_prev : This is the previous diff_id which the data is
being compared to. This is done so that if a diff_id gets
deleted, you can state there is an error.
f. fieldname : This is the field of the row which the data
belongs to.
g. primary : This is the primary key of the row we are looking at.
h. error_code : "start" means there is no diff_id previous
to this one. "diff" means there is a previous entry to
be compared to. "stop" means the primary key has been deleted.
Other error codes are possible.
n. An entry of 0 into a foreign key means null. All rows with a primary
key of 0 should have empty space for text and 0 for numeric values
or the default value (if supplied).
2. The unique names which cannot be used are:
a. "error_code", "backup_id", "date_created", "date_updated",
, "diff_id" and "active" are reserved fields.
3. Standard practices with Perl Modules and other programming languages.
a. All Perl Modules (or other programming languages) will create
objects whose methods correspond to each stored procedure. The naming
convention of each method shall be exactly the sql function name minus
the tablename and "_sql". Thus, "TABLENAME_FUNCTION_sql" becomes
"FUNCTION" in the Perl Module. There will be an exact one to one
correspondence between all sql functions and perl methods, minus
custom made sql functions or perl methods.
b. All custom made perl methods must use stored procedures for all
changing of data, and selecting data (when stored procedures
can return multiple variables).
4. Standard practices of custom stored procedures.
a. All custom stored procedures may only change data using one of the
predefined stored procedures. Custom stored procedures may not
use custom made stored procedures for changing/inserting data.
b. All select statements must use select stored procedures (when the
stored procedures can return multiple values).
5. Standard practices of webpages/perl scripts.
a. All perl scripts or other programming languages will always
use perl modules for all interactivity with database. All changing,
inserting, or viewing data will occur through a module.
misc/nielsen/Test/Config.txt 0100664 0000765 0000765 00000000066 07352131117 015020 0 ustar mark mark
PRE_HOME /tmp/Test
SERVER_ROOT /usr/local/apache
misc/nielsen/Test/List 0100664 0000765 0000765 00000002312 07352156426 013716 0 ustar mark mark 8 ./Docs/SDS.txt
8 ./Docs/SDS.txt~
20 ./Docs
4 ./Config.txt
4 ./List
4 ./sample/Backups
4 ./sample/Custom/Perl
4 ./sample/Custom/Sql/users.sql
4 ./sample/Custom/Sql/contact.sql
4 ./sample/Custom/Sql/contact.sql~
4 ./sample/Custom/Sql/users.sql~
4 ./sample/Custom/Sql/class.sql
4 ./sample/Custom/Sql/students.sql
4 ./sample/Custom/Sql/class.sql~
4 ./sample/Custom/Sql/students.sql~
36 ./sample/Custom/Sql
44 ./sample/Custom
4 ./sample/Output
4 ./sample/Config.txt
4 ./sample/Tables.txt
4 ./sample/Config.txt~
4 ./sample/Tables.txt~
72 ./sample
4 ./Templates/Constants.pm
4 ./Templates/Custom.sql
4 ./Templates/Misc.pm~
12 ./Templates/Custom_Html1.html
8 ./Templates/Custom_Html1.html~
4 ./Templates/Misc.pm
4 ./Templates/Custom_Lists.html
0 ./Templates/Error_No_User.pl.txt
16 ./Templates/Generic.fun~
4 ./Templates/Email.pm_header
20 ./Templates/Generic.fun
4 ./Templates/Error_No_User.pl
4 ./Templates/Constants.pm~
8 ./Templates/Get_Info.pm_header
8 ./Templates/Get_Info.pm_header~
8 ./Templates/Set_Info.pm_header~
4 ./Templates/Password
8 ./Templates/Set_Info.pm_header
4 ./Templates/Set_Info.pm_template
4 ./Templates/htaccess
136 ./Templates
28 ./Create_Functions.pl.txt
24 ./Create_Functions.pl.txt~
8 ./SDS.txt~
300 .
misc/nielsen/Test/sample/ 0040775 0000765 0000765 00000000000 07365020737 014345 5 ustar mark mark misc/nielsen/Test/sample/Backups/ 0040775 0000765 0000765 00000000000 07352120772 015731 5 ustar mark mark misc/nielsen/Test/sample/Custom/ 0040775 0000765 0000765 00000000000 07352121002 015576 5 ustar mark mark misc/nielsen/Test/sample/Custom/Perl/ 0040775 0000765 0000765 00000000000 07352120777 016522 5 ustar mark mark misc/nielsen/Test/sample/Custom/Sql/ 0040775 0000765 0000765 00000000000 07370276034 016355 5 ustar mark mark misc/nielsen/Test/sample/Custom/Sql/users.sql 0100664 0000765 0000765 00000004412 07370276034 020235 0 ustar mark mark select sql_users_insert();
select sql_users_update(1,'Username1','Password1',1,1);
select sql_users_insert();
select sql_users_update(2,'Username2','Password2',1,2);
drop function sql_users_verify(text,text);
CREATE FUNCTION sql_users_verify (text,text) RETURNS int4 AS '
DECLARE
record1 record; id int4 :=0;
username text; password text;
active int4 := 0;
BEGIN
username := clean_text($1);
password := clean_text($2);
FOR record1 IN SELECT users_id FROM users
where users.username = username
and users.password = password
and users.active = 1
LOOP
id := record1.users_id;
END LOOP;
-- If id < 1 check if username exists .
IF id is NULL THEN
FOR record1 IN SELECT users_id,active FROM users
where users.username = username
LOOP
id := record1.users_id;
-- active := record1.active;
-- If active is < 1, isn not active.
-- IF active < 1 THEN return (-3); END IF;
-- If id is > 0, password is incorrect.
IF id > 0 THEN return (-2); END IF;
END LOOP;
END IF;
-- If id is < 1, username does not exist.
IF id < 1 THEN return (-1); END IF;
-- Everything has passed, return id as users_id.
return (id);
END;
' LANGUAGE 'plpgsql';
select sql_users_verify('Username1','Password1');
drop function sql_users_exists(text);
CREATE FUNCTION sql_users_exists (text) RETURNS int4 AS '
DECLARE
record1 record; id int4 :=0;
username text; password text;
BEGIN
username := clean_text($1);
FOR record1 IN SELECT users_id FROM users
where users.username = username
LOOP
id := record1.users_id;
END LOOP;
-- Everything has passed, return id as users_id.
return (id);
END;
' LANGUAGE 'plpgsql';
select sql_users_exists('Username1');
drop function sql_users_active(text);
CREATE FUNCTION sql_users_active (text) RETURNS int4 AS '
DECLARE
record1 record; id int4 :=0;
username text; password text;
BEGIN
username := clean_text($1);
FOR record1 IN SELECT users_id FROM users where users.username = username
LOOP
id := record1.users_id;
END LOOP;
-- Everything has passed, return id as users_id.
return (id);
END;
' LANGUAGE 'plpgsql';
select sql_users_active('Username1');
misc/nielsen/Test/sample/Custom/Sql/contact.sql 0100664 0000765 0000765 00000000511 07352132742 020520 0 ustar mark mark select sql_contact_insert();
select sql_contact_update(1,1,'Company ABC','Dummy1','','Account','nobody@nowhere.com','','','','','','San Jose','CA','95135','USA');
select sql_contact_insert();
select sql_contact_update(2,1,'Company ABC','Dummy2','','Account','nobody2@nowhere.com','','','','','','Columbus','OH','43221','USA');
misc/nielsen/Test/sample/Custom/Sql/contact.sql~ 0100664 0000765 0000765 00000000243 07352123636 020722 0 ustar mark mark select sql_contact_insert();
select sql_contact_update(1,1,'Company ABC','Dummy','','Account','nobody@nowhere.com','','','','','','San Jose','CA','95135','USA');
misc/nielsen/Test/sample/Custom/Sql/users.sql~ 0100664 0000765 0000765 00000004406 07352327676 020447 0 ustar mark mark select sql_users_insert();
select sql_users_update(1,'Username1','Password1',1);
select sql_users_insert();
select sql_users_update(2,'Username2','Password2',1);
drop function sql_users_verify(text,text);
CREATE FUNCTION sql_users_verify (text,text) RETURNS int4 AS '
DECLARE
record1 record; id int4 :=0;
username text; password text;
active int4 := 0;
BEGIN
username := clean_text($1);
password := clean_text($2);
FOR record1 IN SELECT users_id FROM users
where users.username = username
and users.password = password
and users.active = 1
LOOP
id := record1.users_id;
END LOOP;
-- If id < 1 check if username exists .
IF id is NULL THEN
FOR record1 IN SELECT users_id,active FROM users
where users.username = username
LOOP
id := record1.users_id;
-- active := record1.active;
-- If active is < 1, isn not active.
-- IF active < 1 THEN return (-3); END IF;
-- If id is > 0, password is incorrect.
IF id > 0 THEN return (-2); END IF;
END LOOP;
END IF;
-- If id is < 1, username does not exist.
IF id < 1 THEN return (-1); END IF;
-- Everything has passed, return id as users_id.
return (id);
END;
' LANGUAGE 'plpgsql';
select sql_users_verify('Username1','Password1');
drop function sql_users_exists(text);
CREATE FUNCTION sql_users_exists (text) RETURNS int4 AS '
DECLARE
record1 record; id int4 :=0;
username text; password text;
BEGIN
username := clean_text($1);
FOR record1 IN SELECT users_id FROM users
where users.username = username
LOOP
id := record1.users_id;
END LOOP;
-- Everything has passed, return id as users_id.
return (id);
END;
' LANGUAGE 'plpgsql';
select sql_users_exists('Username1');
drop function sql_users_active(text);
CREATE FUNCTION sql_users_active (text) RETURNS int4 AS '
DECLARE
record1 record; id int4 :=0;
username text; password text;
BEGIN
username := clean_text($1);
FOR record1 IN SELECT users_id FROM users where users.username = username
LOOP
id := record1.users_id;
END LOOP;
-- Everything has passed, return id as users_id.
return (id);
END;
' LANGUAGE 'plpgsql';
select sql_users_active('Username1');
misc/nielsen/Test/sample/Custom/Sql/class.sql 0100664 0000765 0000765 00000000506 07352133361 020174 0 ustar mark mark select sql_class_insert();
select sql_class_update(1,'2 hours', 'Introduction to Linux Part 1','This is a description of this class. Not much here so far.', 1);
select sql_class_insert();
select sql_class_update(2,'3 hours', 'Introduction to Linux Part 2','This is a description of this class. Not much here so far.', 2);
misc/nielsen/Test/sample/Custom/Sql/students.sql 0100664 0000765 0000765 00000000423 07352133572 020742 0 ustar mark mark select sql_students_insert();
select sql_students_update(1,1,1);
select sql_students_insert();
select sql_students_update(2,2,1);
select sql_students_insert();
select sql_students_update(3,1,2);
select sql_students_insert();
select sql_students_update(4,2,2);
misc/nielsen/Test/sample/Custom/Sql/class.sql~ 0100664 0000765 0000765 00000000516 07352133127 020373 0 ustar mark mark select sql_contact_insert();
select sql_contact_update(1,'2 hours', 'Introduction to Linux Part 1','This is a description of this class. Not much here so far.', 1);
select sql_contact_insert();
select sql_contact_update(2,'3 hours', 'Introduction to Linux Part 2','This is a description of this class. Not much here so far.', 2);
misc/nielsen/Test/sample/Custom/Sql/students.sql~ 0100664 0000765 0000765 00000000423 07352133345 021136 0 ustar mark mark select sql_students_insert();
select sql_students_update(1,1,1);
select sql_students_insert();
select sql_students_update(1,2,1);
select sql_students_insert();
select sql_students_update(1,1,2);
select sql_students_insert();
select sql_students_update(1,2,2);
misc/nielsen/Test/sample/Output/ 0040775 0000765 0000765 00000000000 07352121010 015623 5 ustar mark mark misc/nielsen/Test/sample/Config.txt 0100664 0000765 0000765 00000000333 07352121531 016275 0 ustar mark mark
PACKAGE SAMPLE
BLOWFISH_KEY ABC BLOWFISH KEY 123456789012345
DESTINATION_HTML /usr/local/apache/htdocs/sample/sample
DESTINATION_MODULES /usr/local/apache/lib/perl/SAMPLE
TEMPDIR /tmp
WEB_ROOT /usr/local/apache/htdocs
misc/nielsen/Test/sample/Tables.txt 0100664 0000765 0000765 00000002174 07365020737 016321 0 ustar mark mark ### The ordering of the tables is very important since we create
### foriegn key constraints.
TABLENAME contact
company_name text NOT NULL default ''
first text NOT NULL default ''
middle text NOT NULL default ''
last text NOT NULL default ''
email text NOT NULL default ''
work_phone text NOT NULL default ''
home_phone text NOT NULL default ''
address_1 text NOT NULL default '',
address_2 text NOT NULL default ''
address_3 text NOT NULL default ''
city text NOT NULL default ''
state text NOT NULL default ''
zip text NOT NULL default ''
country text NOT NULL default ''
TABLENAME users
username text NOT NULL default '',
password text NOT NULL default '',
user_type int4 not null default 1
contact_id int4 not null default 0
#### These are the classes anybody can make up.
#### contact_id refers to the contact person, or the teacher.
TABLENAME class
time text not null default ''
title text not null default ''
description text not null default ''
users_id int4 not null default 0
### Just need two things, the contact id and the class id.
TABLENAME students
users_id int4 not null default 0
class_id int4 not null default 0
misc/nielsen/Test/sample/Config.txt~ 0100664 0000765 0000765 00000000445 07352121026 016476 0 ustar mark mark
PACKAGE MAIL
BLOWFISH_KEY MAI BLOWFISH KEY 123456789012345
DESTINATION_HTML /usr/local/apache_tcu-inc/htdocs_ges/sample/mail
DESTINATION_MODULES /usr/local/apache_tcu-inc/lib/perl/MAIL
TEMPDIR /home/mark/apache_tcu-inc/htdocs_ges/mail/admin/temp
WEB_ROOT /usr/local/apache_tcu-inc/htdocs_ges
misc/nielsen/Test/sample/Tables.txt~ 0100664 0000765 0000765 00000002177 07352327547 016527 0 ustar mark mark ### The ordering of the tables is very important since we create
### foriegn key constraints.
TABLENAME users
username text NOT NULL default '',
password text NOT NULL default '',
user_type int4 not null default 1
TABLENAME contact
users_id int4 not NULL default 0,
company_name text NOT NULL default ''
first text NOT NULL default ''
middle text NOT NULL default ''
last text NOT NULL default ''
email text NOT NULL default ''
work_phone text NOT NULL default ''
home_phone text NOT NULL default ''
address_1 text NOT NULL default '',
address_2 text NOT NULL default ''
address_3 text NOT NULL default ''
city text NOT NULL default ''
state text NOT NULL default ''
zip text NOT NULL default ''
country text NOT NULL default ''
#### These are the classes anybody can make up.
#### contact_id refers to the contact person, or the teacher.
TABLENAME class
time text not null default ''
title text not null default ''
description text not null default ''
contact_id int4 not null default 0
### Just need two things, the contact id and the class id.
TABLENAME students
contact_id int4 not null default 0
class_id int4 not null default 0
misc/nielsen/Test/Templates/ 0040775 0000765 0000765 00000000000 07370404135 015014 5 ustar mark mark misc/nielsen/Test/Templates/Constants.pm 0100755 0000765 0000765 00000003736 07370404135 017335 0 ustar mark mark #!/usr/bin/perl
# Create Functions for Perl/PostgreSQL version 1.0
# Copyright 2001, Mark Nielsen
# All rights reserved.
# This Copyright notice was copied and modified from the Perl
# Copyright notice.
# This program is free software; you can redistribute it and/or modify
# it under the terms of either:
# a) the GNU General Public License as published by the Free
# Software Foundation; either version 1, or (at your option) any
# later version, or
# b) the "Artistic License" which comes with this Kit.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either
# the GNU General Public License or the Artistic License for more details.
# You should have received a copy of the Artistic License with this
# Kit, in the file named "Artistic". If not, I'll be glad to provide one.
# You should also have received a copy of the GNU General Public License
# along with this program in the file named "Copying". If not, write to the
# Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
# 02111-1307, USA or visit their web page on the internet at
# http://www.gnu.org/copyleft/gpl.html.
package PACKAGE::Constants;
use strict;
use Apache;
use DBI;
sub Get_Constants
{
my (@Temp) = @_;
### Have all the subroutines execute here and stuff the results
### into an array.
my $Global = {};
my $dbh;
use DBI;
use DBI;
#$dbh ||= DBI->connect('dbi:Pg:dbname=DATABASE',"","");
$dbh ||= DBI->connect('dbi:Pg:dbname=DATABASE',"","", {PrintError=>0});
if ($dbh ) {$dbh->{PrintError} = 1;}
else
{$dbh ||= DBI->connect('dbi:Pg:dbname=DATABASE;host=127.0.0.1',"","",
{PrintError=>1});}
$Global->{'dbh'} = $dbh;
$Global->{'tempdir'} = 'TEMPDIR';
$Global->{'web_root'} = 'WEB_ROOT';
return ($Global);
}
1;
misc/nielsen/Test/Templates/Email.pm_header~ 0100664 0000765 0000765 00000001230 07352121067 020100 0 ustar mark mark #!/usr/bin/perl
package PACKAGE::Email;
use strict;
use Apache;
use DBI;
use Apache::DBI;
use CGI;
use PACKAGE::Misc;
use PACKAGE::Constants;
use Mail::Mailer;
sub new
{
my $Class = shift;
my %Args = @_;
my $self = {};
$self->{'mail'} = new Mail::Mailer 'sendmail';
bless $self,$Class;
return ($self);
}
#--------------------------------------------------------------------------
sub Send_Mail {
my $self = shift;
my %Args = @_;
my $Header = {};
if (exists $Args{'header'}) { $Header = $Args{'header'};}
else {return (-1)};
my $Body = $Args{'body'};
my $Mail = $self->{'mail'};
$Mail->open($Header);
print $Mail $Body;
$Mail->close;
return (1);
}
1;
misc/nielsen/Test/Templates/Custom.sql 0100664 0000765 0000765 00000002673 07352121067 017014 0 ustar mark mark
drop function clean_text (text);
CREATE FUNCTION clean_text (text) RETURNS text AS '
my $Text = shift;
# Get rid of whitespace in front.
$Text =~ s/^\\s+//;
# Get rid of whitespace at end.
$Text =~ s/\\s+$//;
# Get rid of anything not text.
$Text =~ s/[^ a-z0-9\\/\\`\\~\\!\\@\\#\\$\\%\\^\\&\\*\\(\\)\\-\\_\\=\\+\\\\\\|\[\\{\\]\\}\\;\\:\\''\\"\\,\\<\\.\\>\\?\\t\\n]//gi;
# Replace all multiple whitespace with one space.
$Text =~ s/\\s+/ /g;
return $Text;
' LANGUAGE 'plperl';
-- Just do show you what this function cleans up.
select clean_text (' ,./<>?aaa aa !@#$%^&*()_+| ');
drop function clean_alpha (text);
CREATE FUNCTION clean_alpha (text) RETURNS text AS '
my $Text = shift;
$Text =~ s/[^a-z0-9_]//gi;
return $Text;
' LANGUAGE 'plperl';
-- Just do show you what this function cleans up.
select clean_alpha (' ,./<>?aaa aa !@#$%^&*()_+| ');
drop function clean_numeric (text);
CREATE FUNCTION clean_numeric (text) RETURNS int4 AS '
my $Text = shift;
$Text =~ s/[^0-9]//gi;
return $Text;
' LANGUAGE 'plperl';
-- Just do show you what this function cleans up.
select clean_numeric (' ,./<>?aaa aa !@#$%^&*()_+| ');
drop function clean_numeric (int4);
CREATE FUNCTION clean_numeric (int4) RETURNS int4 AS '
my $Text = shift;
$Text =~ s/[^0-9]//gi;
return $Text;
' LANGUAGE 'plperl';
-- Just do show you what this function cleans up.
select clean_numeric (11111);
misc/nielsen/Test/Templates/Misc.pm~ 0100644 0000765 0000765 00000007701 07352354237 016452 0 ustar mark mark #!/usr/bin/perl
# Create Functions for Perl/PostgreSQL version 1.0
# Copyright 2001, Mark Nielsen
# All rights reserved.
# This Copyright notice was copied and modified from the Perl
# Copyright notice.
# This program is free software; you can redistribute it and/or modify
# it under the terms of either:
# a) the GNU General Public License as published by the Free
# Software Foundation; either version 1, or (at your option) any
# later version, or
# b) the "Artistic License" which comes with this Kit.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either
# the GNU General Public License or the Artistic License for more details.
# You should have received a copy of the Artistic License with this
# Kit, in the file named "Artistic". If not, I'll be glad to provide one.
# You should also have received a copy of the GNU General Public License
# along with this program in the file named "Copying". If not, write to the
# Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
# 02111-1307, USA or visit their web page on the internet at
# http://www.gnu.org/copyleft/gpl.html.
package PACKAGE::Misc;
use strict;
use Apache;
use DBI;
use Apache::DBI;
use CGI;
use Crypt::Blowfish;
use PACKAGE::Constants;
my $Blowfish_Key = "BLOWFISH_KEY";
my $Blowfish_Cipher = new Crypt::Blowfish $Blowfish_Key;
#-----------------------------------
sub Encrypt
{
my $self = shift;
my $String = shift;
my $Temp = $String;
my $Encrypted = "";
while (length $Temp > 0)
{
while (length $Temp < 8) {$Temp .= "\t";}
my $Temp2 = $Blowfish_Cipher->encrypt(substr($Temp,0,8));
$Encrypted .= $Temp2;
if (length $Temp > 8) {$Temp = substr($Temp,8);} else {$Temp = "";}
}
my $Unpacked = unpack("H*",$Encrypted);
return ($Unpacked);
}
#-------------------------------------------------------------------------
sub Decrypt
{
my $self = shift;
my $String = shift;
my $Packed = pack("H*",$String);
my $Temp = $Packed;
my $Decrypted = "";
while (length $Temp > 0)
{
my $Temp2 = substr($Temp,0,8);
if (length $Temp2 == 8)
{
my $Temp3 = $Blowfish_Cipher->decrypt($Temp2);
$Decrypted .= $Temp3;
}
if (length $Temp > 8) {$Temp = substr($Temp,8);} else {$Temp = "";}
}
$Decrypted =~ s/\t+$//g;
return ($Decrypted);
}
#-------------------------------------------
sub Convert_Html
{
my $self = shift;
my $String = shift;
if (ref $String) {$String = "";}
else
{
$String =~ s/\&/\&\;/g;
$String =~ s/\"/\"\;/g;
$String =~ s/\>/\>\;/g;
$String =~ s/\ 0) {$String = substr($String,0,$No);}
if (ref $String) {$String = "";}
else
{
$String =~ s/[^a-zA-Z0-9 \~\!\@\#\$\%\^\&\*\(\)\_\+\-\=\\\[\]\;\'\,\.\/\{\}\:\"\<\>\?\n\|]//g;
}
return ($String);
}
#--------------------------------------------------------------------
sub File_Query
{
my $self = shift;
my %Args = @_;
if (!(exists $Args{'file'})) {return (-1);}
my $File = $Args{'file'};
my (@Temp) = split(/\./, $File);
my $Ext = pop @Temp;
if (!($Ext =~ /[a-z]/i)) {$Ext = "ext";}
my $Global = MAIL::Constants->Get_Constants;
my $TempDir = $Global->{'tempdir'};
my $New = "$TempDir/1.$Ext";
my $No = 1;
while (-e $File) {$No++; $File = "$TempDir/$No.$Ext";}
my $buffer;
open (OUTFILE,">$New");
while (my $bytesread=read($File,$buffer,1024)) {print OUTFILE $buffer;}
close OUTFILE;
#if ($Ext eq ".wav")
# {
# my $Command = "cd $Data_Dir; /usr/local/realproducer-8.5/realproducer -i intro$Ext";
# system ($Command);
# }
return ($File);
}
misc/nielsen/Test/Templates/Custom_Html1.html 0100755 0000765 0000765 00000021440 07352144545 020226 0 ustar mark mark #!/usr/bin/perl
# Create Functions for Perl/PostgreSQL version 1.0
# Copyright 2001, Mark Nielsen
# All rights reserved.
# This Copyright notice was copied and modified from the Perl
# Copyright notice.
# This program is free software; you can redistribute it and/or modify
# it under the terms of either:
# a) the GNU General Public License as published by the Free
# Software Foundation; either version 1, or (at your option) any
# later version, or
# b) the "Artistic License" which comes with this Kit.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either
# the GNU General Public License or the Artistic License for more details.
# You should have received a copy of the Artistic License with this
# Kit, in the file named "Artistic". If not, I'll be glad to provide one.
# You should also have received a copy of the GNU General Public License
# along with this program in the file named "Copying". If not, write to the
# Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
# 02111-1307, USA or visit their web page on the internet at
# http://www.gnu.org/copyleft/gpl.html.
### PACKAGE TABLENAME SCRIPTNAME
#print "Content-type: text/html\n\n\n";
#-------------------------------------------------
# Load the standard modules and initiaize variables.
use strict;
use PACKAGE::Misc;
use PACKAGE::Constants;
use PACKAGE::Get_Info;
use PACKAGE::Set_Info;
use CGI;
my $Global = PACKAGE::Constants::Get_Constants;
### Get the database connection.
my $dbh = $Global->{'dbh'};
## Load the get info module.
my $Info = new PACKAGE::Get_Info;
## Grab the user_id, if we don't get one, abort.
my $User_Id = $Info->{'users'}->{'users_id'};
## If $ENV{'REMOTE_USER'} is not defined, and that username doesn't
## exist in the users table, abort. We assume that is $ENV{'REMOTE_USER'}
## is defined that they logged in correctly.
my $User_Okay = 1;
if ($User_Id < 1) {print "Location: Error_No_User.pl\n\n";}
#------------------------------------------------------------
# Print Content-Type and get the queried variables.
print "Content-type: text/html\n\n\n";
my $query = new CGI;
my $Update = $query->param('update');
my $Action = $query->param('action');
my @Params = $query->param();
my $Id_Encrypted = $query->param('id');
my $Id = 0;
if ($Id_Encrypted ne "") {$Id = PACKAGE::Misc->Decrypt($Id_Encrypted);}
my $Ids = {};
my $Ids_Encrypted= {};
OTHERIDS
#-------------------------------------------
# Execute any perl methods, which in turn correspond to a database method.
# We could create a generic perl method for this for any table.
# All we would have to do is submit a list of fields for "new" and
# "update" plus the id.
if ($Action eq "new") {$Id = "";}
elsif ($Action eq "delete")
{
my $Delete = new PACKAGE::Set_Info;
my $Result = $Delete->Set_TABLENAME('id'=>$Id,'command'=>'delete');
$Id = "";
}
elsif ($Action eq "undelete")
{
my $Undelete = new PACKAGE::Set_Info;
my $Result = $Undelete->Set_TABLENAME('id'=>$Id,'command'=>'undelete');
}
elsif ($Action eq "purge")
{
my $Purge = new PACKAGE::Set_Info;
my $Result = $Purge->Set_TABLENAME('id'=>$Id,'command'=>'delete');
my $Result = $Purge->Set_TABLENAME('id'=>$Id,'command'=>'purgeone');
$Id = "";
}
elsif ($Update eq "update")
{
### Update the title of the list
my $Update = new PACKAGE::Set_Info;
### Create the array that we want to submit to the function.
my $Fields = {};
DEFINEFIELDS
### Update the table and submit the $Fields array.
my $Result = $Update->Set_TABLENAME('id'=>$Id,'command'=>'change','fields'=>$Fields);
}
elsif ($Update eq "new")
{
my $Insert = new PACKAGE::Set_Info;
### Insert new thing into TABLENAME table.
$Id = $Insert->Set_TABLENAME('command'=>'insert');
### Create the array that we want to submit to the function.
my $Fields = {};
DEFINEFIELDS
### Hardcode the users_id if you don't want it to change.
# $Fields->{'users_id'} = $User_Id;
# $query->param(-delete=>'users_id');
# $query->param(-name=>'users_id',value=>$Info->{'users'}->{'users_id'});
my $Result = $Insert->Set_TABLENAME('id'=>$Id,'command'=>'change',"fields"=>$Fields);
}
#----------------------------------------------------------------------
# Now create a list of all the items in this table. Then we can choose
# which ones we want to edit. This could be put into a perl method
# instead of duplicating it for each webpage.
### Now taken care of by the module Get_TABLENAME
### Create the main list of items we are editing.
### If there is a users_id in the table, only select the ones that we own.
my $List = "";
my $Id_Values = {};
### You might want to modify this sql so that you use more descriptive titles.
my $Temp_List = $Info->List('TABLENAME','all','none');
foreach my $Key (sort keys %$Temp_List)
{
my $ref = $Temp_List->{$Key};
my $Selected = "";
if ($ref->{'TABLENAME_id'} eq $Id) {$Selected = " selected";}
my $Id_Encrypt = PACKAGE::Misc->Encrypt($ref->{'TABLENAME_id'});
my $Status = "Active";
if ($ref->{'active'} == 0) {$Status = "Inactive";}
my $Title = $ref->{'TABLENAME_id'};
### We are looking for the field "title", but change it so what the field
### should be. This is just an example.
if (exists $ref->{'title'}) {$Title = $ref->{'title'}}
$List .= qq( $Status : $Title\n);
}
if ($List eq "") {$List = " None\n";}
#-------------------------------------------------------------------
# Get all the information about this entry in the table.
# Again we could create a standard perl module to do this.
my $Other_Lists = {};
my $Other_Info = {};
my $Type = "new";
my $Id_Encrypt = "";
my $Message = "Create a new TABLENAME.";
my $TABLENAME_Info = {};
if ($Id > 0)
{
$Type = "update";
$Id_Encrypt = PACKAGE::Misc->Encrypt($Id);
## Get the information about the email_list
$TABLENAME_Info = $Info->Info('TABLENAME', $Id);
$Message = "Update Information for TABLENAME_id = $Id.";
### Remember to create a list to choose between ids, and also the
### capability to directly change the data of the foriegn id without
### changing the id being edited.
SETIDSOTHER
}
#-------------------------------------------------------------------
# Create the other lists for primary keys of other tables.
# This could be modularized as well.
OTHER_LISTS
#------------------------------------------------------------------
# Print out the html code with some debug info at bottom.
print qq(
PACKAGE : TABLENAME editing
);
#print "";
print qq (
);
print qq(
Editing data in the table "TABLENAME".
);
print "
These sample webpages should follow the
SDS (Standard Database Setup) since they don't create any custom sql
queries but use standard Perl modules. \n";
print "
$Status : $Title\n);
}
if ($List eq "") {$List = " None\n";}
#-------------------------------------------------------------------
# Get all the information about this entry in the table.
# Again we could create a standard perl module to do this.
my $Other_Lists = {};
my $Other_Info = {};
my $Type = "new";
my $Id_Encrypt = "";
my $Message = "Create a new TABLENAME.";
my $TABLENAME_Info = {};
if ($Id > 0)
{
$Type = "update";
$Id_Encrypt = PACKAGE::Misc->Encrypt($Id);
## Get the information about the email_list
$TABLENAME_Info = $Info->Info('TABLENAME', $Id);
$Message = "Update Information for TABLENAME_id = $Id.";
### Remember to create a list to choose between ids, and also the
### capability to directly change the data of the foriegn id without
### changing the id being edited.
SETIDSOTHER
}
#-------------------------------------------------------------------
# Create the other lists for primary keys of other tables.
# This could be modularized as well.
OTHER_LISTS
#------------------------------------------------------------------
# Print out the html code with some debug info at bottom.
print qq(
PACKAGE : TABLENAME editing
);
#print "";
print qq (
);
print qq(
Editing data in the table "TABLENAME".
);
print "
These sample webpages should follow the
SDS (Standard Database Setup) since they don't create any custom sql
queries but use standard Perl modules. \n";
print "
$ref->{'TABLENAME_id'} : $Status\n);
}
misc/nielsen/Test/Templates/Error_No_User.pl.txt 0120777 0000765 0000765 00000000000 07352136660 023771 2Error_No_User.pl ustar mark mark misc/nielsen/Test/Templates/Generic.fun~ 0100664 0000765 0000765 00000042234 07352144371 017305 0 ustar mark mark --- Generic Functions for Perl/Postgresql version 1.0
--- Copyright 2001, Mark Nielsen
--- All rights reserved.
--- This Copyright notice was copied and modified from the Perl
--- Copyright notice.
--- This program is free software; you can redistribute it and/or modify
--- it under the terms of either:
--- a) the GNU General Public License as published by the Free
--- Software Foundation; either version 1, or (at your option) any
--- later version, or
--- b) the "Artistic License" which comes with this Kit.
--- This program is distributed in the hope that it will be useful,
--- but WITHOUT ANY WARRANTY; without even the implied warranty of
--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either
--- the GNU General Public License or the Artistic License for more details.
--- You should have received a copy of the Artistic License with this
--- Kit, in the file named "Artistic". If not, I'll be glad to provide one.
--- You should also have received a copy of the GNU General Public License
--- along with this program in the file named "Copying". If not, write to the
--- Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
--- 02111-1307, USA or visit their web page on the internet at
--- http://www.gnu.org/copyleft/gpl.html.
-- create a method to unpurge just one item.
-- create a method to purge one item.
-- \i HOME/TABLENAME.table
---------------------------------------------------------------------
drop function sql_TABLENAME_insert ();
CREATE FUNCTION sql_TABLENAME_insert () RETURNS int4 AS '
DECLARE
record1 record; oid1 int4; id int4 :=0; record_backup RECORD;
BEGIN
insert into TABLENAME (date_updated, date_created, active)
values (CURRENT_TIMESTAMP,CURRENT_TIMESTAMP, 1);
-- Get the unique oid of the row just inserted.
GET DIAGNOSTICS oid1 = RESULT_OID;
-- Get the TABLENAME id.
FOR record1 IN SELECT TABLENAME_id FROM TABLENAME where oid = oid1
LOOP
id := record1.TABLENAME_id;
END LOOP;
-- If id is NULL, insert failed or something is wrong.
IF id is NULL THEN return (-1); END IF;
-- It should also be greater than 0, otherwise something is wrong.
IF id < 1 THEN return (-2); END IF;
-- Now backup the data.
FOR record_backup IN SELECT * FROM TABLENAME where TABLENAME_id = id
LOOP
insert into TABLENAME_backup (TABLENAME_id, date_updated, date_created,
active, error_code)
values (id, record_backup.date_updated, record_backup.date_created,
record_backup.active, ''insert'');
END LOOP;
-- Everything has passed, return id as TABLENAME_id.
return (id);
END;
' LANGUAGE 'plpgsql';
---------------------------------------------------------------------
drop function sql_TABLENAME_delete (int4);
CREATE FUNCTION sql_TABLENAME_delete (int4) RETURNS int2 AS '
DECLARE
id int4 := 0;
id_exists int4 := 0;
record1 RECORD;
record_backup RECORD;
return_int4 int4 :=0;
BEGIN
-- If the id is not greater than 0, return error.
id := clean_numeric($1);
IF id < 1 THEN return -1; END IF;
-- If we find the id, set active = 0.
FOR record1 IN SELECT TABLENAME_id FROM TABLENAME
where TABLENAME_id = id
LOOP
update TABLENAME set active=0, date_updated = CURRENT_TIMESTAMP
where TABLENAME_id = id;
GET DIAGNOSTICS return_int4 = ROW_COUNT;
id_exists := 1;
END LOOP;
-- If we did not find the id, abort and return -2.
IF id_exists = 0 THEN return (-2); END IF;
FOR record_backup IN SELECT * FROM TABLENAME where TABLENAME_id = id
LOOP
insert into TABLENAME_backup (TABLENAME_id, date_updated, date_created,
active BACKUPCOLUMNS ,error_code)
values (record_backup.TABLENAME_id, record_backup.date_updated,
record_backup.date_updated, record_backup.active
BACKUPVALUES , ''delete''
);
END LOOP;
-- If id_exists == 0, Return error.
-- It means it never existed.
IF id_exists = 0 THEN return (-1); END IF;
-- We got this far, it must be true, return ROW_COUNT.
return (return_int4);
END;
' LANGUAGE 'plpgsql';
---------------------------------------------------------------------
drop function sql_TABLENAME_undelete (int4);
CREATE FUNCTION sql_TABLENAME_undelete (int4) RETURNS int2 AS '
DECLARE
id int4 := 0;
id_exists int4 := 0;
record1 RECORD;
record_backup RECORD;
return_int4 int4 :=0;
BEGIN
-- If the id is not greater than 0, return error.
id := clean_numeric($1);
IF id < 1 THEN return -1; END IF;
-- If we find the id, set active = 1.
FOR record1 IN SELECT TABLENAME_id FROM TABLENAME
where TABLENAME_id = id
LOOP
update TABLENAME set active=1, date_updated = CURRENT_TIMESTAMP
where TABLENAME_id = id;
GET DIAGNOSTICS return_int4 = ROW_COUNT;
id_exists := 1;
END LOOP;
-- If we did not find the id, abort and return -2.
IF id_exists = 0 THEN return (-2); END IF;
FOR record_backup IN SELECT * FROM TABLENAME where TABLENAME_id = id
LOOP
insert into TABLENAME_backup (TABLENAME_id, date_updated, date_created,
active BACKUPCOLUMNS ,error_code)
values (record_backup.TABLENAME_id, record_backup.date_updated,
record_backup.date_updated, record_backup.active
BACKUPVALUES , ''undelete''
);
END LOOP;
-- If id_exists == 0, Return error.
-- It means it never existed.
IF id_exists = 0 THEN return (-1); END IF;
-- We got this far, it must be true, return ROW_COUNT.
return (return_int4);
END;
' LANGUAGE 'plpgsql';
---------------------------------------------------------------------
drop function sql_TABLENAME_update (int4 FIELDS);
CREATE FUNCTION sql_TABLENAME_update (int4 FIELDS)
RETURNS int2 AS '
DECLARE
id int4 := 0;
id_exists int4 := 0;
record_update RECORD; record_backup RECORD;
return_int4 int4 :=0;
CLEANVARIABLES
BEGIN
REMAKEVARIABLES
-- If the id is not greater than 0, return error.
id := clean_numeric($1);
IF id < 1 THEN return -1; END IF;
FOR record_update IN SELECT TABLENAME_id FROM TABLENAME
where TABLENAME_id = id
LOOP
id_exists := 1;
END LOOP;
IF id_exists = 0 THEN return (-2); END IF;
update TABLENAME set date_updated = CURRENT_TIMESTAMP
UPDATEFIELDS
where TABLENAME_id = id;
GET DIAGNOSTICS return_int4 = ROW_COUNT;
FOR record_backup IN SELECT * FROM TABLENAME where TABLENAME_id = id
LOOP
insert into TABLENAME_backup (TABLENAME_id,
date_updated, date_created, active
BACKUPCOLUMNS, error_code)
values (record_update.TABLENAME_id, record_backup.date_updated,
record_backup.date_updated, record_backup.active
BACKUPVALUES, ''update''
);
END LOOP;
-- We got this far, it must be true, return ROW_COUNT.
return (return_int4);
END;
' LANGUAGE 'plpgsql';
---------------------------------------------------------------------
drop function sql_TABLENAME_copy (int4);
CREATE FUNCTION sql_TABLENAME_copy (int4)
RETURNS int2 AS '
DECLARE
id int4 := 0;
id_exists int4 := 0;
record1 RECORD; record2 RECORD; record3 RECORD;
return_int4 int4 := 0;
id_new int4 := 0;
TABLENAME_new int4 :=0;
BEGIN
-- If the id is not greater than 0, return error.
id := clean_numeric($1);
IF id < 1 THEN return -1; END IF;
FOR record1 IN SELECT TABLENAME_id FROM TABLENAME where TABLENAME_id = id
LOOP
id_exists := 1;
END LOOP;
IF id_exists = 0 THEN return (-2); END IF;
--- Get the new id
FOR record1 IN SELECT sql_TABLENAME_insert() as TABLENAME_insert
LOOP
TABLENAME_new := record1.TABLENAME_insert;
END LOOP;
-- If the TABLENAME_new is not greater than 0, return error.
IF TABLENAME_new < 1 THEN return -3; END IF;
FOR record2 IN SELECT * FROM TABLENAME where TABLENAME_id = id
LOOP
FOR record1 IN SELECT sql_TABLENAME_update(TABLENAME_new COPYFIELDS)
as TABLENAME_insert
LOOP
-- execute some arbitrary command just to get it to pass.
id_exists := 1;
END LOOP;
END LOOP;
-- We got this far, it must be true, return new id.
return (TABLENAME_new);
END;
' LANGUAGE 'plpgsql';
------------------------------------------------------------------
drop function sql_TABLENAME_purge ();
CREATE FUNCTION sql_TABLENAME_purge () RETURNS int4 AS '
DECLARE
record_backup RECORD; oid1 int4 := 0;
return_int4 int4 :=0;
deleted int4 := 0;
delete_count int4 :=0;
delete_id int4;
BEGIN
-- Now delete one by one.
FOR record_backup IN SELECT * FROM TABLENAME where active = 0
LOOP
-- Record the id we want to delete.
delete_id = record_backup.TABLENAME_id;
insert into TABLENAME_backup (TABLENAME_id, date_updated, date_created,
active BACKUPCOLUMNS ,error_code)
values (record_backup.TABLENAME_id, record_backup.date_updated,
record_backup.date_updated, record_backup.active
BACKUPVALUES , ''purge''
);
-- Get the unique oid of the row just inserted.
GET DIAGNOSTICS oid1 = RESULT_OID;
-- If oid1 less than 1, return -1
IF oid1 < 1 THEN return (-2); END IF;
-- Now delete this from the main table.
delete from TABLENAME where TABLENAME_id = delete_id;
-- Get row count of row just deleted, should be 1.
GET DIAGNOSTICS deleted = ROW_COUNT;
-- If deleted less than 1, return -3
IF deleted < 1 THEN return (-3); END IF;
delete_count := delete_count + 1;
END LOOP;
-- We got this far, it must be true, return the number of ones we had.
return (delete_count);
END;
' LANGUAGE 'plpgsql';
------------------------------------------------------------------
drop function sql_TABLENAME_purgeone (int4);
CREATE FUNCTION sql_TABLENAME_purgeone (int4) RETURNS int4 AS '
DECLARE
record_backup RECORD; oid1 int4 := 0;
record1 RECORD;
return_int4 int4 :=0;
deleted int4 := 0;
delete_count int4 :=0;
delete_id int4;
purged_no int4 := 0;
BEGIN
delete_id := $1;
-- If purged_id less than 1, return -4
IF delete_id < 1 THEN return (-4); END IF;
FOR record1 IN SELECT * FROM TABLENAME
where active = 0 and TABLENAME_id = delete_id
LOOP
purged_no := purged_no + 1;
END LOOP;
-- If purged_no less than 1, return -1
IF purged_no < 1 THEN return (-1); END IF;
-- Now delete one by one.
FOR record_backup IN SELECT * FROM TABLENAME where TABLENAME_id = delete_id
LOOP
insert into TABLENAME_backup (TABLENAME_id, date_updated, date_created,
active BACKUPCOLUMNS ,error_code)
values (record_backup.TABLENAME_id, record_backup.date_updated,
record_backup.date_updated, record_backup.active
BACKUPVALUES , ''purgeone''
);
-- Get the unique oid of the row just inserted.
GET DIAGNOSTICS oid1 = RESULT_OID;
-- If oid1 less than 1, return -2
IF oid1 < 1 THEN return (-2); END IF;
-- Now delete this from the main table.
delete from TABLENAME where TABLENAME_id = delete_id;
-- Get row count of row just deleted, should be 1.
GET DIAGNOSTICS deleted = ROW_COUNT;
-- If deleted less than 1, return -3
IF deleted < 1 THEN return (-3); END IF;
delete_count := delete_count + 1;
END LOOP;
-- We got this far, it must be true, return the number of ones we had.
return (delete_count);
END;
' LANGUAGE 'plpgsql';
------------------------------------------------------------------------
drop function sql_TABLENAME_unpurge ();
CREATE FUNCTION sql_TABLENAME_unpurge () RETURNS int2 AS '
DECLARE
record1 RECORD;
record2 RECORD;
record_backup RECORD;
purged_id int4 := 0;
purge_count int4 :=0;
timestamp1 timestamp;
purged_no int4 := 0;
oid1 int4 := 0;
oid_found int4 := 0;
highest_oid int4 := 0;
BEGIN
-- Now get the unique ids that were purged.
FOR record1 IN select distinct TABLENAME_id from TABLENAME_backup
where TABLENAME_backup.error_code = ''purge''
and NOT TABLENAME_id = ANY (select TABLENAME_id from TABLENAME)
LOOP
purged_id := record1.TABLENAME_id;
timestamp1 := CURRENT_TIMESTAMP;
purged_no := purged_no + 1;
oid_found := 0;
highest_oid := 0;
-- Now we have the unique id, find its latest date.
FOR record2 IN select max(oid) from TABLENAME_backup
where TABLENAME_id = purged_id and error_code = ''purge''
LOOP
-- record we got the date and also record the highest date.
oid_found := 1;
highest_oid := record2.max;
END LOOP;
-- If the oid_found is 0, return error.
IF oid_found = 0 THEN return (-3); END IF;
-- Now we have the latest date, get the values and insert them.
FOR record_backup IN select * from TABLENAME_backup
where oid = highest_oid
LOOP
insert into TABLENAME_backup (TABLENAME_id, date_updated, date_created,
active BACKUPCOLUMNS ,error_code)
values (purged_id, record_backup.date_updated,
timestamp1, record_backup.active
BACKUPVALUES , ''unpurge''
);
-- Get the unique oid of the row just inserted.
GET DIAGNOSTICS oid1 = RESULT_OID;
-- If oid1 less than 1, return -1
IF oid1 < 1 THEN return (-1); END IF;
insert into TABLENAME (TABLENAME_id, date_updated, date_created,
active BACKUPCOLUMNS)
values (purged_id, timestamp1,
timestamp1, record_backup.active
BACKUPVALUES );
-- Get the unique oid of the row just inserted.
GET DIAGNOSTICS oid1 = RESULT_OID;
-- If oid1 less than 1, return -2
IF oid1 < 1 THEN return (-2); END IF;
END LOOP;
END LOOP;
-- We got this far, it must be true, return how many were affected.
return (purged_no);
END;
' LANGUAGE 'plpgsql';
---------------------------------------------------------------------
drop function sql_TABLENAME_unpurgeone (int4);
CREATE FUNCTION sql_TABLENAME_unpurgeone (int4) RETURNS int2 AS '
DECLARE
record_id int4;
record1 RECORD;
record2 RECORD;
record_backup RECORD;
return_int4 int4 :=0;
purged_id int4 := 0;
purge_count int4 :=0;
timestamp1 timestamp;
purged_no int4 := 0;
oid1 int4 := 0;
oid_found int4 := 0;
highest_oid int4 := 0;
BEGIN
purged_id := $1;
-- If purged_id less than 1, return -1
IF purged_id < 1 THEN return (-1); END IF;
--- Get the current timestamp.
timestamp1 := CURRENT_TIMESTAMP;
FOR record1 IN select distinct TABLENAME_id from TABLENAME_backup
where TABLENAME_backup.error_code = ''purge''
and NOT TABLENAME_id = ANY (select TABLENAME_id from TABLENAME)
and TABLENAME_id = purged_id
LOOP
purged_no := purged_no + 1;
END LOOP;
-- If purged_no less than 1, return -1
IF purged_no < 1 THEN return (-3); END IF;
-- Now find the highest oid.
FOR record2 IN select max(oid) from TABLENAME_backup
where TABLENAME_id = purged_id and error_code = ''purge''
LOOP
-- record we got the date and also record the highest date.
oid_found := 1;
highest_oid := record2.max;
END LOOP;
-- If the oid_found is 0, return error.
IF oid_found = 0 THEN return (-4); END IF;
-- Now get the data and restore it.
FOR record_backup IN select * from TABLENAME_backup
where oid = highest_oid
LOOP
-- Insert into backup that it was unpurged.
insert into TABLENAME_backup (TABLENAME_id, date_updated, date_created,
active BACKUPCOLUMNS ,error_code)
values (purged_id, timestamp1,
record_backup.date_created, record_backup.active
BACKUPVALUES , ''unpurgeone''
);
-- Get the unique oid of the row just inserted.
GET DIAGNOSTICS oid1 = RESULT_OID;
-- If oid1 less than 1, return -1
IF oid1 < 1 THEN return (-1); END IF;
-- Insert into live table.
insert into TABLENAME (TABLENAME_id, date_updated, date_created,
active BACKUPCOLUMNS)
values (record_backup.TABLENAME_id, timestamp1,
record_backup.date_updated, record_backup.active
BACKUPVALUES );
-- Get the unique oid of the row just inserted.
GET DIAGNOSTICS oid1 = RESULT_OID;
-- If oid1 less than 1, return -2
IF oid1 < 1 THEN return (-2); END IF;
END LOOP;
-- We got this far, it must be true, return how many were affected (1).
return (purged_no);
END;
' LANGUAGE 'plpgsql';
insert into TABLENAME (TABLENAME_id, date_updated, date_created, active)
values (0, CURRENT_TIMESTAMP, CURRENT_TIMESTAMP, 0);
insert into TABLENAME_backup (backup_id, TABLENAME_id,
date_updated, date_created, active, error_code)
values (0, 0, CURRENT_TIMESTAMP, CURRENT_TIMESTAMP, 0, "table creation");
misc/nielsen/Test/Templates/Email.pm_header 0100664 0000765 0000765 00000001207 07365020226 017705 0 ustar mark mark #!/usr/bin/perl
package PACKAGE::Email;
use strict;
use Apache;
use DBI;
use CGI;
use PACKAGE::Misc;
use PACKAGE::Constants;
use Mail::Mailer;
sub new
{
my $Class = shift;
my %Args = @_;
my $self = {};
$self->{'mail'} = new Mail::Mailer 'sendmail';
bless $self,$Class;
return ($self);
}
#--------------------------------------------------------------------------
sub Send_Mail {
my $self = shift;
my %Args = @_;
my $Header = {};
if (exists $Args{'header'}) { $Header = $Args{'header'};}
else {return (-1)};
my $Body = $Args{'body'};
my $Mail = $self->{'mail'};
$Mail->open($Header);
print $Mail $Body;
$Mail->close;
return (1);
}
1;
misc/nielsen/Test/Templates/Generic.fun 0100664 0000765 0000765 00000042234 07352354626 017115 0 ustar mark mark --- Generic Functions for Perl/Postgresql version 1.0
--- Copyright 2001, Mark Nielsen
--- All rights reserved.
--- This Copyright notice was copied and modified from the Perl
--- Copyright notice.
--- This program is free software; you can redistribute it and/or modify
--- it under the terms of either:
--- a) the GNU General Public License as published by the Free
--- Software Foundation; either version 1, or (at your option) any
--- later version, or
--- b) the "Artistic License" which comes with this Kit.
--- This program is distributed in the hope that it will be useful,
--- but WITHOUT ANY WARRANTY; without even the implied warranty of
--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either
--- the GNU General Public License or the Artistic License for more details.
--- You should have received a copy of the Artistic License with this
--- Kit, in the file named "Artistic". If not, I'll be glad to provide one.
--- You should also have received a copy of the GNU General Public License
--- along with this program in the file named "Copying". If not, write to the
--- Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
--- 02111-1307, USA or visit their web page on the internet at
--- http://www.gnu.org/copyleft/gpl.html.
-- create a method to unpurge just one item.
-- create a method to purge one item.
-- \i HOME/TABLENAME.table
---------------------------------------------------------------------
drop function sql_TABLENAME_insert ();
CREATE FUNCTION sql_TABLENAME_insert () RETURNS int4 AS '
DECLARE
record1 record; oid1 int4; id int4 :=0; record_backup RECORD;
BEGIN
insert into TABLENAME (date_updated, date_created, active)
values (CURRENT_TIMESTAMP,CURRENT_TIMESTAMP, 1);
-- Get the unique oid of the row just inserted.
GET DIAGNOSTICS oid1 = RESULT_OID;
-- Get the TABLENAME id.
FOR record1 IN SELECT TABLENAME_id FROM TABLENAME where oid = oid1
LOOP
id := record1.TABLENAME_id;
END LOOP;
-- If id is NULL, insert failed or something is wrong.
IF id is NULL THEN return (-1); END IF;
-- It should also be greater than 0, otherwise something is wrong.
IF id < 1 THEN return (-2); END IF;
-- Now backup the data.
FOR record_backup IN SELECT * FROM TABLENAME where TABLENAME_id = id
LOOP
insert into TABLENAME_backup (TABLENAME_id, date_updated, date_created,
active, error_code)
values (id, record_backup.date_updated, record_backup.date_created,
record_backup.active, ''insert'');
END LOOP;
-- Everything has passed, return id as TABLENAME_id.
return (id);
END;
' LANGUAGE 'plpgsql';
---------------------------------------------------------------------
drop function sql_TABLENAME_delete (int4);
CREATE FUNCTION sql_TABLENAME_delete (int4) RETURNS int2 AS '
DECLARE
id int4 := 0;
id_exists int4 := 0;
record1 RECORD;
record_backup RECORD;
return_int4 int4 :=0;
BEGIN
-- If the id is not greater than 0, return error.
id := clean_numeric($1);
IF id < 1 THEN return -1; END IF;
-- If we find the id, set active = 0.
FOR record1 IN SELECT TABLENAME_id FROM TABLENAME
where TABLENAME_id = id
LOOP
update TABLENAME set active=0, date_updated = CURRENT_TIMESTAMP
where TABLENAME_id = id;
GET DIAGNOSTICS return_int4 = ROW_COUNT;
id_exists := 1;
END LOOP;
-- If we did not find the id, abort and return -2.
IF id_exists = 0 THEN return (-2); END IF;
FOR record_backup IN SELECT * FROM TABLENAME where TABLENAME_id = id
LOOP
insert into TABLENAME_backup (TABLENAME_id, date_updated, date_created,
active BACKUPCOLUMNS ,error_code)
values (record_backup.TABLENAME_id, record_backup.date_updated,
record_backup.date_updated, record_backup.active
BACKUPVALUES , ''delete''
);
END LOOP;
-- If id_exists == 0, Return error.
-- It means it never existed.
IF id_exists = 0 THEN return (-1); END IF;
-- We got this far, it must be true, return ROW_COUNT.
return (return_int4);
END;
' LANGUAGE 'plpgsql';
---------------------------------------------------------------------
drop function sql_TABLENAME_undelete (int4);
CREATE FUNCTION sql_TABLENAME_undelete (int4) RETURNS int2 AS '
DECLARE
id int4 := 0;
id_exists int4 := 0;
record1 RECORD;
record_backup RECORD;
return_int4 int4 :=0;
BEGIN
-- If the id is not greater than 0, return error.
id := clean_numeric($1);
IF id < 1 THEN return -1; END IF;
-- If we find the id, set active = 1.
FOR record1 IN SELECT TABLENAME_id FROM TABLENAME
where TABLENAME_id = id
LOOP
update TABLENAME set active=1, date_updated = CURRENT_TIMESTAMP
where TABLENAME_id = id;
GET DIAGNOSTICS return_int4 = ROW_COUNT;
id_exists := 1;
END LOOP;
-- If we did not find the id, abort and return -2.
IF id_exists = 0 THEN return (-2); END IF;
FOR record_backup IN SELECT * FROM TABLENAME where TABLENAME_id = id
LOOP
insert into TABLENAME_backup (TABLENAME_id, date_updated, date_created,
active BACKUPCOLUMNS ,error_code)
values (record_backup.TABLENAME_id, record_backup.date_updated,
record_backup.date_updated, record_backup.active
BACKUPVALUES , ''undelete''
);
END LOOP;
-- If id_exists == 0, Return error.
-- It means it never existed.
IF id_exists = 0 THEN return (-1); END IF;
-- We got this far, it must be true, return ROW_COUNT.
return (return_int4);
END;
' LANGUAGE 'plpgsql';
---------------------------------------------------------------------
drop function sql_TABLENAME_update (int4 FIELDS);
CREATE FUNCTION sql_TABLENAME_update (int4 FIELDS)
RETURNS int2 AS '
DECLARE
id int4 := 0;
id_exists int4 := 0;
record_update RECORD; record_backup RECORD;
return_int4 int4 :=0;
CLEANVARIABLES
BEGIN
REMAKEVARIABLES
-- If the id is not greater than 0, return error.
id := clean_numeric($1);
IF id < 1 THEN return -1; END IF;
FOR record_update IN SELECT TABLENAME_id FROM TABLENAME
where TABLENAME_id = id
LOOP
id_exists := 1;
END LOOP;
IF id_exists = 0 THEN return (-2); END IF;
update TABLENAME set date_updated = CURRENT_TIMESTAMP
UPDATEFIELDS
where TABLENAME_id = id;
GET DIAGNOSTICS return_int4 = ROW_COUNT;
FOR record_backup IN SELECT * FROM TABLENAME where TABLENAME_id = id
LOOP
insert into TABLENAME_backup (TABLENAME_id,
date_updated, date_created, active
BACKUPCOLUMNS, error_code)
values (record_update.TABLENAME_id, record_backup.date_updated,
record_backup.date_updated, record_backup.active
BACKUPVALUES, ''update''
);
END LOOP;
-- We got this far, it must be true, return ROW_COUNT.
return (return_int4);
END;
' LANGUAGE 'plpgsql';
---------------------------------------------------------------------
drop function sql_TABLENAME_copy (int4);
CREATE FUNCTION sql_TABLENAME_copy (int4)
RETURNS int2 AS '
DECLARE
id int4 := 0;
id_exists int4 := 0;
record1 RECORD; record2 RECORD; record3 RECORD;
return_int4 int4 := 0;
id_new int4 := 0;
TABLENAME_new int4 :=0;
BEGIN
-- If the id is not greater than 0, return error.
id := clean_numeric($1);
IF id < 1 THEN return -1; END IF;
FOR record1 IN SELECT TABLENAME_id FROM TABLENAME where TABLENAME_id = id
LOOP
id_exists := 1;
END LOOP;
IF id_exists = 0 THEN return (-2); END IF;
--- Get the new id
FOR record1 IN SELECT sql_TABLENAME_insert() as TABLENAME_insert
LOOP
TABLENAME_new := record1.TABLENAME_insert;
END LOOP;
-- If the TABLENAME_new is not greater than 0, return error.
IF TABLENAME_new < 1 THEN return -3; END IF;
FOR record2 IN SELECT * FROM TABLENAME where TABLENAME_id = id
LOOP
FOR record1 IN SELECT sql_TABLENAME_update(TABLENAME_new COPYFIELDS)
as TABLENAME_insert
LOOP
-- execute some arbitrary command just to get it to pass.
id_exists := 1;
END LOOP;
END LOOP;
-- We got this far, it must be true, return new id.
return (TABLENAME_new);
END;
' LANGUAGE 'plpgsql';
------------------------------------------------------------------
drop function sql_TABLENAME_purge ();
CREATE FUNCTION sql_TABLENAME_purge () RETURNS int4 AS '
DECLARE
record_backup RECORD; oid1 int4 := 0;
return_int4 int4 :=0;
deleted int4 := 0;
delete_count int4 :=0;
delete_id int4;
BEGIN
-- Now delete one by one.
FOR record_backup IN SELECT * FROM TABLENAME where active = 0
LOOP
-- Record the id we want to delete.
delete_id = record_backup.TABLENAME_id;
insert into TABLENAME_backup (TABLENAME_id, date_updated, date_created,
active BACKUPCOLUMNS ,error_code)
values (record_backup.TABLENAME_id, record_backup.date_updated,
record_backup.date_updated, record_backup.active
BACKUPVALUES , ''purge''
);
-- Get the unique oid of the row just inserted.
GET DIAGNOSTICS oid1 = RESULT_OID;
-- If oid1 less than 1, return -1
IF oid1 < 1 THEN return (-2); END IF;
-- Now delete this from the main table.
delete from TABLENAME where TABLENAME_id = delete_id;
-- Get row count of row just deleted, should be 1.
GET DIAGNOSTICS deleted = ROW_COUNT;
-- If deleted less than 1, return -3
IF deleted < 1 THEN return (-3); END IF;
delete_count := delete_count + 1;
END LOOP;
-- We got this far, it must be true, return the number of ones we had.
return (delete_count);
END;
' LANGUAGE 'plpgsql';
------------------------------------------------------------------
drop function sql_TABLENAME_purgeone (int4);
CREATE FUNCTION sql_TABLENAME_purgeone (int4) RETURNS int4 AS '
DECLARE
record_backup RECORD; oid1 int4 := 0;
record1 RECORD;
return_int4 int4 :=0;
deleted int4 := 0;
delete_count int4 :=0;
delete_id int4;
purged_no int4 := 0;
BEGIN
delete_id := $1;
-- If purged_id less than 1, return -4
IF delete_id < 1 THEN return (-4); END IF;
FOR record1 IN SELECT * FROM TABLENAME
where active = 0 and TABLENAME_id = delete_id
LOOP
purged_no := purged_no + 1;
END LOOP;
-- If purged_no less than 1, return -1
IF purged_no < 1 THEN return (-1); END IF;
-- Now delete one by one.
FOR record_backup IN SELECT * FROM TABLENAME where TABLENAME_id = delete_id
LOOP
insert into TABLENAME_backup (TABLENAME_id, date_updated, date_created,
active BACKUPCOLUMNS ,error_code)
values (record_backup.TABLENAME_id, record_backup.date_updated,
record_backup.date_updated, record_backup.active
BACKUPVALUES , ''purgeone''
);
-- Get the unique oid of the row just inserted.
GET DIAGNOSTICS oid1 = RESULT_OID;
-- If oid1 less than 1, return -2
IF oid1 < 1 THEN return (-2); END IF;
-- Now delete this from the main table.
delete from TABLENAME where TABLENAME_id = delete_id;
-- Get row count of row just deleted, should be 1.
GET DIAGNOSTICS deleted = ROW_COUNT;
-- If deleted less than 1, return -3
IF deleted < 1 THEN return (-3); END IF;
delete_count := delete_count + 1;
END LOOP;
-- We got this far, it must be true, return the number of ones we had.
return (delete_count);
END;
' LANGUAGE 'plpgsql';
------------------------------------------------------------------------
drop function sql_TABLENAME_unpurge ();
CREATE FUNCTION sql_TABLENAME_unpurge () RETURNS int2 AS '
DECLARE
record1 RECORD;
record2 RECORD;
record_backup RECORD;
purged_id int4 := 0;
purge_count int4 :=0;
timestamp1 timestamp;
purged_no int4 := 0;
oid1 int4 := 0;
oid_found int4 := 0;
highest_oid int4 := 0;
BEGIN
-- Now get the unique ids that were purged.
FOR record1 IN select distinct TABLENAME_id from TABLENAME_backup
where TABLENAME_backup.error_code = ''purge''
and NOT TABLENAME_id = ANY (select TABLENAME_id from TABLENAME)
LOOP
purged_id := record1.TABLENAME_id;
timestamp1 := CURRENT_TIMESTAMP;
purged_no := purged_no + 1;
oid_found := 0;
highest_oid := 0;
-- Now we have the unique id, find its latest date.
FOR record2 IN select max(oid) from TABLENAME_backup
where TABLENAME_id = purged_id and error_code = ''purge''
LOOP
-- record we got the date and also record the highest date.
oid_found := 1;
highest_oid := record2.max;
END LOOP;
-- If the oid_found is 0, return error.
IF oid_found = 0 THEN return (-3); END IF;
-- Now we have the latest date, get the values and insert them.
FOR record_backup IN select * from TABLENAME_backup
where oid = highest_oid
LOOP
insert into TABLENAME_backup (TABLENAME_id, date_updated, date_created,
active BACKUPCOLUMNS ,error_code)
values (purged_id, record_backup.date_updated,
timestamp1, record_backup.active
BACKUPVALUES , ''unpurge''
);
-- Get the unique oid of the row just inserted.
GET DIAGNOSTICS oid1 = RESULT_OID;
-- If oid1 less than 1, return -1
IF oid1 < 1 THEN return (-1); END IF;
insert into TABLENAME (TABLENAME_id, date_updated, date_created,
active BACKUPCOLUMNS)
values (purged_id, timestamp1,
timestamp1, record_backup.active
BACKUPVALUES );
-- Get the unique oid of the row just inserted.
GET DIAGNOSTICS oid1 = RESULT_OID;
-- If oid1 less than 1, return -2
IF oid1 < 1 THEN return (-2); END IF;
END LOOP;
END LOOP;
-- We got this far, it must be true, return how many were affected.
return (purged_no);
END;
' LANGUAGE 'plpgsql';
---------------------------------------------------------------------
drop function sql_TABLENAME_unpurgeone (int4);
CREATE FUNCTION sql_TABLENAME_unpurgeone (int4) RETURNS int2 AS '
DECLARE
record_id int4;
record1 RECORD;
record2 RECORD;
record_backup RECORD;
return_int4 int4 :=0;
purged_id int4 := 0;
purge_count int4 :=0;
timestamp1 timestamp;
purged_no int4 := 0;
oid1 int4 := 0;
oid_found int4 := 0;
highest_oid int4 := 0;
BEGIN
purged_id := $1;
-- If purged_id less than 1, return -1
IF purged_id < 1 THEN return (-1); END IF;
--- Get the current timestamp.
timestamp1 := CURRENT_TIMESTAMP;
FOR record1 IN select distinct TABLENAME_id from TABLENAME_backup
where TABLENAME_backup.error_code = ''purge''
and NOT TABLENAME_id = ANY (select TABLENAME_id from TABLENAME)
and TABLENAME_id = purged_id
LOOP
purged_no := purged_no + 1;
END LOOP;
-- If purged_no less than 1, return -1
IF purged_no < 1 THEN return (-3); END IF;
-- Now find the highest oid.
FOR record2 IN select max(oid) from TABLENAME_backup
where TABLENAME_id = purged_id and error_code = ''purge''
LOOP
-- record we got the date and also record the highest date.
oid_found := 1;
highest_oid := record2.max;
END LOOP;
-- If the oid_found is 0, return error.
IF oid_found = 0 THEN return (-4); END IF;
-- Now get the data and restore it.
FOR record_backup IN select * from TABLENAME_backup
where oid = highest_oid
LOOP
-- Insert into backup that it was unpurged.
insert into TABLENAME_backup (TABLENAME_id, date_updated, date_created,
active BACKUPCOLUMNS ,error_code)
values (purged_id, timestamp1,
record_backup.date_created, record_backup.active
BACKUPVALUES , ''unpurgeone''
);
-- Get the unique oid of the row just inserted.
GET DIAGNOSTICS oid1 = RESULT_OID;
-- If oid1 less than 1, return -1
IF oid1 < 1 THEN return (-1); END IF;
-- Insert into live table.
insert into TABLENAME (TABLENAME_id, date_updated, date_created,
active BACKUPCOLUMNS)
values (record_backup.TABLENAME_id, timestamp1,
record_backup.date_updated, record_backup.active
BACKUPVALUES );
-- Get the unique oid of the row just inserted.
GET DIAGNOSTICS oid1 = RESULT_OID;
-- If oid1 less than 1, return -2
IF oid1 < 1 THEN return (-2); END IF;
END LOOP;
-- We got this far, it must be true, return how many were affected (1).
return (purged_no);
END;
' LANGUAGE 'plpgsql';
insert into TABLENAME (TABLENAME_id, date_updated, date_created, active)
values (0, CURRENT_TIMESTAMP, CURRENT_TIMESTAMP, 0);
insert into TABLENAME_backup (backup_id, TABLENAME_id,
date_updated, date_created, active, error_code)
values (0, 0, CURRENT_TIMESTAMP, CURRENT_TIMESTAMP, 0, 'table creation');
misc/nielsen/Test/Templates/Error_No_User.pl 0100664 0000765 0000765 00000000316 07352121067 020071 0 ustar mark mark #!/usr/bin/perl
print "Content-type: text/html\n\n\n";
print " Nore mote user defined. Please enable user authentication. \n";
foreach my $Env (sort keys %ENV) {print "; chomp $R;
if ($R =~ /n/i) {exit;}
elsif (!($R =~ /y/i)) {exit;}
### We want to define some variables WHICH YOU SHOULD CHANGE FOR YOUR
### OWN COMPUTER.
### These two variables are defined by general configuration.
my $Pre_Home = "/var/www/html/database";
my $Server_Root = "/usr/local/apache";
### Now grab any local configuration for this database.
### We should put a check in here detecting if we are executing in the
### directory that this script is in.
if (!(-e "Config.txt"))
{
print "Error, no Config.txt file. Aborting. We need the main Config.txt file to be defined.\n";
exit;
}
### Now load the file, parse it, and assign variables.
open(FILE,"Config.txt"); my @File = ; close FILE;
grep(chomp $_, @File);
@File = grep($_ =~ /[a-z0-9]/i, @File);
grep($_ =~ s/\t/ /g, @File);
grep($_ =~ s/^ +//g, @File);
grep($_ =~ s/ +$//g, @File);
@File = grep(!($_ =~ /\#/), @File); # Delete any lines with '#' in them.
foreach my $Line (@File)
{
my ($Key,$Value) = split(/ /, $Line, 2);
if ($Key eq "PRE_HOME") {$Pre_Home = $Value;}
elsif ($Key eq "SERVER_ROOT") {$Server_Root = $Value;}
# print "$Key = $Value\n";
}
### We should put a chdir command here to force us to the right directory.
### These 4 variables are defined by the database. Create the directory.
if (!(-e "$Pre_Home/$Database"))
{
system "mkdir -p $Pre_Home/$Database/Output/Tables";
system "mkdir -p $Pre_Home/$Database/Output/Perl/HTML";
system "mkdir -p $Pre_Home/$Database/Custom/Perl";
system "mkdir -p $Pre_Home/$Database/Custom/Sql";
system "mkdir -p $Pre_Home/$Database/Backups";
}
my $Package = "SAMPLE_DATABASE";
my $Blowfish_Key = "MAI BLOWFISH KEY 123456789012345";
my $Destination_Html = "$Server_Root/htdocs_ges/sample/$Database";
my $Destination_Modules = "$Server_Root/lib/perl/SAMPLE_DATABASE";
my $TempDir = "/tmp/temp_dir";
my $Web_Root = "$TempDir";
### Now grab any local configuration for this database.
if (!(-e "$Pre_Home/$Database/Config.txt"))
{
print "Error, no Config.txt file. Aborting.\n We need the file\n$Pre_Home/$Database/Config.txt\n to be defined.\n";
exit;
}
### Now load the file, parse it, and assign variables.
open(FILE,"$Pre_Home/$Database/Config.txt"); my @File = ; close FILE;
grep(chomp $_, @File); ## delete newlines.
@File = grep($_ =~ /[a-z0-9]/i, @File); ## Delete blank lines.
grep($_ =~ s/\t/ /g, @File); # Convert tabs to spaces.
grep($_ =~ s/^ +//g, @File); # Delete beginning spaces.
grep($_ =~ s/ +$//g, @File); # Delete ending spaces.
@File = grep(!($_ =~ /\#/), @File); # Delete any lines with '#' in them.
foreach my $Line (@File)
{
my ($Key,$Value) = split(/ /, $Line, 2);
if ($Key eq "BLOWFISH_KEY") {$Blowfish_Key = $Value;}
elsif ($Key eq "DESTINATION_HTML") {$Destination_Html = $Value;}
elsif ($Key eq "DESTINATION_MODULES") { $Destination_Modules = $Value;}
elsif ($Key eq "PACKAGE") { $Package = $Value;}
elsif ($Key eq "TEMPDIR") { $TempDir = $Value;}
elsif ($Key eq "WEB_ROOT") { $Web_Root = $Value;}
else {print "Uknown configuration, aborting. $Key = $Value\n"; exit;}
}
## Make the directories if they don't exist.
if (!(-e $Destination_Html)) {system "mkdir -p $Destination_Html";}
if (!(-e $Destination_Modules)) {system "mkdir -p $Destination_Modules";}
if (!(-e $TempDir)) {system "mkdir -p $TempDir";}
### Variables after this point should not be touched.
### Define all the variables for the Perl script
my $Home = "$Pre_Home/$Database";
my $File = "$Home/Tables.txt";
### I don't think I use the $TempFile anywhere. For future use.
my $TempFile = "$Home/Tempfile.txt";
my $Main_Templates = "$Pre_Home/Templates";
my $SQL_Template = "$Main_Templates/Generic.fun";
my $SQL_Custom = "$Main_Templates/Custom.sql";
my $Perl_Module_Set_Header = "$Main_Templates/Set_Info.pm_header";
my $Perl_Module_Set_Template = "$Main_Templates/Set_Info.pm_template";
my $Perl_Module_Get_Header = "$Main_Templates/Get_Info.pm_header";
### Define all the variables for this database
my $Templates = "$Home";
my $Perl_Module_Set_Output = "$Home/Output/Perl/Set_Info.pm";
my $Perl_Module_Set_Custom = "$Templates/Custom/Perl/Set_Info.pm_custom";
my $Perl_Module_Get_Output = "$Home/Output/Perl/Get_Info.pm";
my $Perl_Module_Get_Custom = "$Templates/Custom/Perl/Get_Info.pm_custom";
my $Perl_Module_Email_Custom = "$Templates/Custom/Perl/Email.pm_custom";
#------------------------------------------------------------------------
## Let us create the directories we need if they are not there.
if (!(-e "$Home")) {system "mkdir -p $Home";}
if (!(-e "$Home/Output/Tables")) {system "mkdir -p $Home/Output/Tables"}
if (!(-e "$Home/Backups")) {system "mkdir -p $Home/Backups"}
if (!(-e "$Home/Custom")) {system "mkdir -p $Home/Custom"}
if (!(-e "$Home/Output/Perl/HTML")) {system "mkdir -p $Home/Output/Perl/HTML"}
## Of course, I haven't done the php, java, python stuff, but
## I want to set it up so that it is obvious how i want to do it.
if (!(-e "$Home/Output/Php/HTML")) {system "mkdir -p $Home/Output/Php/HTML"}
if (!(-e "$Home/Output/Python/HTML"))
{system "mkdir -p $Home/Output/Python/HTML"}
if (!(-e "$Home/Output/Java/HTML")) {system "mkdir -p $Home/Output/Java/HTML"}
### Open up the template for the functions and the file that contains
### the info to create the tables.
### If the file with tables doesn't exit, abort.
if (!(-e "$Home/Tables.txt"))
{print "Error, $Home/Tables.txt does not exist, aborting.\n"; exit;}
open(FILE,$SQL_Template); my @SQL_Template = ; close FILE;
open(FILE,$File); my @File = ; close FILE;
open(FILE,$SQL_Custom); my @SQL_Custom = ; close FILE;
open(FILE,$Perl_Module_Set_Template); my @Perl_S_T = ; close FILE;
### Filter out lines that have no numbers or letters.
@File = grep($_ =~ /[a-z0-9]/i, @File);
### Get rid of any line which contains a #
@File = grep(!($_ =~ /\#/), @File);
### Get rid of the newline.
grep(chomp $_, @File);
### Get rid of tabs and replace with spaces. .
grep($_ =~ s/\t/ /g, @File);
### Convert all multiple spaces to one.
grep($_ =~ s/ +/ /g, @File);
### Next two lines get rid of spaces and front and end.
grep($_ =~ s/^ //g, @File);
grep($_ =~ s/ $//g, @File);
### Delete any commas at the end, we will put them back on later.
grep($_ =~ s/\,+$//g, @File);
my $Tables = {};
my $Table_Fields = {};
my $TableName = "";
my @Table_List = ();
### For each line in the file, either make a new array for the table,
### or store the lines in the array for a table.
foreach my $Line (@File)
{
my $Junk = "";
### If the line starts with "TABLENAME" then create a new array.
if ($Line =~ /^TABLENAME/)
{
($Junk,$TableName, $Junk) = split(/ /,$Line);
### This creates the aray for the table.
$Tables->{$TableName} = [];
$Table_Fields->{$TableName} = {};
push (@Table_List, $TableName);
}
else
{
### Storing lines for the table.
push (@{$Tables->{$TableName}}, $Line) ;
### This part is redundant, but we need this info.
my ($Name,$Type,$Ext) = split(/ /,$Line,3);
## Backup field names for Perl and other Scripts.
$Table_Fields->{$TableName}->{$Name} = "$Type $Ext";
}
}
### If we listed specific tables, then only do those.
if (@List)
{
foreach my $TableName (sort keys %$Tables)
{
if (!(grep($_ eq $TableName, @List)))
{@Table_List = grep($_ ne $TableName, @Table_List);}
}
}
### Get the keys of the reference to an array $Tables
### and get the data for that array, create our file, and then use the file.
foreach my $TableName (@Table_List)
{
## Create a temporary array which contains the table definitions
my @Temp = @{$Tables->{$TableName}};
my $Backup_Columns = ""; my $Backup_Values = ""; my $Update_Fields = "";
my $Field_Copy_Values = ""; my $FieldTypes = "";
my $CleanVariables = ""; my $RemakeVariables = "";
### The two tables are different in one respect, the backup table
### does not require uniqueness and it doesn't use a sequence.
my $Table = qq($TableName\_id int4 NOT NULL PRIMARY KEY DEFAULT nextval('$TableName\_sequence'),
date_updated timestamp NOT NULL default CURRENT_TIMESTAMP,
date_created timestamp NOT NULL default CURRENT_TIMESTAMP,
active int2 CHECK (active in (0,1)) DEFAULT 0,
);
## I should allow null for the id instead of 0, but since the sequence
### starts at 1, I use 0 as null. I hate nulls.
my $Table_Backup = qq(backup_id int4 NOT NULL UNIQUE DEFAULT nextval('$TableName\_sequence_backup'),
$TableName\_id int4 NOT NULL DEFAULT 0,
date_updated timestamp NOT NULL default CURRENT_TIMESTAMP,
date_created timestamp NOT NULL default CURRENT_TIMESTAMP,
active int2 CHECK (active in (0,1)) DEFAULT 0,
);
print "Creating functions for table '$TableName'\n";
my $No = 1;
### For each line for this table do this.
### We want to create a few variables that are going to be placed into
### the template.
my $Fields = "";
## Foreach line in the table definition
foreach my $Line (@Temp)
{
my ($Name,$Type,$Ext) = split(/ /,$Line,3);
### Detect if name ends in "_id", and if so, add forieng keys constraint.
my $Additional = "";
if ($Name =~ /_id$/)
{
my $TableName = $Name; $TableName =~ s/_id$//g;
### ON DELETE NO ACTION and FORIEGN KEY ($Name) are not needed,
### but I want to be explicit what I am doing.
$Additional = qq( REFERENCES $TableName
ON DELETE NO ACTION
ON UPDATE CASCADE );
}
$Table .= "$Line $Additional,\n";
$Table_Backup .= "$Line,\n";
### Make an array of the fields.
$Fields .= "'$Name',";
### The backup columns
$Backup_Columns .= ", $Name";
### The update fields
$No++; $Update_Fields .= ", $Name = var_$No";
### Backup values
$Backup_Values .= ", record_backup.$Name";
### Now the fields when we copy stuff in the cyop function.
$Field_Copy_Values .= ", clean_text(record2.$Name)";
### Now the field types for the update function.
$FieldTypes .= ", $Type";
### We need to define the variables for the updating function.
$CleanVariables .= " var_$No $Type;\n";
### We need to define the type, I only check for text and int4 for now.
my $Temp = "\$$No";
if ($Type eq "int4") {$Temp = "clean_numeric($Temp)";}
elsif ($Type eq "text") {$Temp = "clean_text($Temp)";}
### Now we need to set the variables.
$RemakeVariables .= " var_$No := $Temp;\n";
### We also need to add the function to clean out the variables before
### they are submitted.
}
### Chop off the last comma for $Fields;
chop $Fields;
### Record how many rows we had. Make a line for the update command for
### testing.
my $Number_Of_Rows = $No;
my $Update_Test = "1";
for (my $i = 1; $i < $Number_Of_Rows - 1; $i++) {$Update_Test .= ",$i";}
### We need to chop off the last comma.
chomp $Table; chop $Table; chomp $Table_Backup; chop $Table_Backup;
### Now let us setup dropping and creating of the table and backup table.
my $Tables = qq(drop table $TableName;\ncreate table $TableName (\n$Table\n););
$Tables .= "drop table $TableName\_backup;\n";
$Tables .= "create table $TableName\_backup (\n$Table_Backup, error_code text NOT NULL DEFAULT ''\n);\n";
### Let us create a view for active stuff in our table.
$Tables .= "drop view $TableName\_active;\n";
$Tables .= "create view $TableName\_active as select * from $TableName
where active = 1;\n";
### Create a view for inactive or deleted items.
$Tables .= "drop view $TableName\_deleted;\n";
$Tables .= "create view $TableName\_deleted as select * from $TableName
where active = 0;\n";
### Create a view for a list of unique backup ids.
$Tables .= "drop view $TableName\_backup_ids;\n";
$Tables .= "create view $TableName\_backup_ids as
select distinct $TableName\_id from $TableName\_backup;\n";
### Create a list of purged data (lastest data per id).
$Tables .= "drop view $TableName\_purged;\n";
$Tables .= "create view $TableName\_purged as
select * from $TableName\_backup where oid = ANY (
select max(oid) from $TableName\_backup where $TableName\_id = ANY
(
select distinct $TableName\_id from $TableName\_backup
where $TableName\_backup.error_code = 'purge'
and NOT $TableName\_id = ANY (select $TableName\_id from $TableName)
)
group by $TableName\_id
)
;\n";
### I use grep commands to search and replace stuff for arrays.
### I could use map, but I like greps.
my @Temp = @SQL_Template;
push (@Temp,@SQL_Custom);
## Now, if there is a custom made file for this table, add it.
if (-e "$Home/Custom/Sql/$TableName\.sql")
{
open(FILE,"$Home/Custom/Sql/$TableName\.sql"); my @Temp2 = ; close FILE;
push (@Temp,@Temp2);
}
grep($_ =~ s/TABLENAME/$TableName/g, @Temp);
grep($_ =~ s/BACKUPCOLUMNS/$Backup_Columns/g, @Temp);
grep($_ =~ s/BACKUPVALUES/$Backup_Values/g, @Temp);
grep($_ =~ s/UPDATEFIELDS/$Update_Fields/g, @Temp);
grep($_ =~ s/COPYFIELDS/$Field_Copy_Values/g, @Temp);
grep($_ =~ s/FIELDS/$FieldTypes/g, @Temp);
grep($_ =~ s/HOME/$Home/g, @Temp);
grep($_ =~ s/CLEANVARIABLES/$CleanVariables/g, @Temp);
grep($_ =~ s/REMAKEVARIABLES/$RemakeVariables/g, @Temp);
### Now move the stuff from the array @Temp to @Template_Copy.
my @Template_Copy = @Temp;
### Now we save the file. We won't delete it (unless you run this script
### again) so that we can figure out what was done.
open(FILE,">$Home/Output/Tables/$TableName\.table_functions");
### Create the sequence for the table .
print FILE "drop sequence $TableName\_sequence;\n";
print FILE "create sequence $TableName\_sequence;\n";
print FILE "drop sequence $TableName\_sequence_backup;\n";
print FILE "create sequence $TableName\_sequence_backup;\n";
### Print out the table and backup table.
print FILE $Tables;
### Print out the 4 functions, insert, delete, update, and copy.
foreach my $Temp (@Template_Copy) {print FILE "$Temp";}
### Print out a vaccum command.
print FILE "vacuum;\n";
close FILE;
### Before we execute, let us backup the table in case some novice
### executes this on a live server.
my $Backup_File = "$Home/Backups/$TableName\_0.backup";
my $No = 0;
while (-e $Backup_File)
{$No++; $Backup_File = "$Home/Backups/$TableName\_$No\.backup";}
### Now we have the filename to store the backup, execute it.
system ("pg_dump -t $TableName -f $Backup_File $Database");
### Uncomment this option if you want to see what is in the file.
## system ("cat $Home/Output/Tables/$TableName\.table_functions");
### Drop table and functions, create table and functions and backup table.
system ("psql -d $Database -c '\\i $Home/Output/Tables/$TableName\.table_functions'");
print "Check the file\n $Home/Output/Tables/$TableName\.table_functions.\n";
## Now, add a custom made file for perl.
open(FILE,">$Home/Output/Perl/$TableName\.pl");
my @Temp_Perl = @Perl_S_T;
grep($_ =~ s/TABLENAME/$TableName/g, @Temp_Perl);
grep($_ =~ s/BACKUPCOLUMNS/$Backup_Columns/g, @Temp_Perl);
grep($_ =~ s/BACKUPVALUES/$Backup_Values/g, @Temp_Perl);
grep($_ =~ s/UPDATEFIELDS/$Update_Fields/g, @Temp_Perl);
grep($_ =~ s/COPYFIELDS/$Field_Copy_Values/g, @Temp_Perl);
grep($_ =~ s/FIELDS/$FieldTypes/g, @Temp_Perl);
grep($_ =~ s/HOME/$Home/g, @Temp_Perl);
grep($_ =~ s/CLEANVARIABLES/$CleanVariables/g, @Temp_Perl);
grep($_ =~ s/REMAKEVARIABLES/$RemakeVariables/g, @Temp_Perl);
grep($_ =~ s/LISTCOLUMNS/$Fields/g, @Temp_Perl);
print FILE @Temp_Perl;
close FILE;
}
#---------------------------------------------------------------------------
#### Perl modules and Perl webpages.
## Load the Perl module header;
open(FILE3,$Perl_Module_Set_Header); my @File = ; close FILE3;
## Gather all the perl scripts we have made.
my @Files = <$Home/Output/Perl/*.pl>;
## Open up the new perl module
open(FILE,">$Perl_Module_Set_Output");
## Print the header to the module
grep($_ =~ s/PACKAGE/$Package/g, @File);
print FILE @File;
## One by one, print the subroutines to the module.
## Also, store the tablenames into an array
my @Get_Info_Array = ();
foreach my $File (@Files)
{
open(FILE2,$File); my @File2 = ; close FILE2;
print FILE @File2;
my (@Temp) = split(/\//, $File);
my $Last = pop @Temp;
my ($Name,$Junk) = split(/\./,$Last,2);
push (@Get_Info_Array,$Name);
}
### Get the custom stuff and append it.
open(FILE3,$Perl_Module_Set_Custom); my @File = ; close FILE3;
print FILE @File;
## Return true for the module.
print FILE "\n1;\n";
close FILE;
### Now create the Get_Info.pm module
my $Valid_Tables = "";
foreach my $Table (@Get_Info_Array)
{$Valid_Tables .= " '$Table',";}
chop $Valid_Tables;
## Load the Perl module header;
open(FILE3,$Perl_Module_Get_Header); my @File = ; close FILE3;
## Open up the new perl module
open(FILE,">$Perl_Module_Get_Output");
## Print the header to the module
grep($_ =~ s/PACKAGE/$Package/g, @File);
grep($_ =~ s/VALIDTABLES/$Valid_Tables/g, @File);
print FILE @File;
## Get the custom made stuff and append it.
open(FILE3,$Perl_Module_Get_Custom); my @File = ; close FILE3;
print FILE @File;
## Return true for the module.
print FILE "\n1;\n";
close FILE;
## Get the Misc.pm module
open(FILE3,"$Main_Templates/Misc.pm"); my @File = ; close FILE3;
open(FILE,">$Home/Output/Perl/Misc.pm");
## Print the module out.
grep($_ =~ s/PACKAGE/$Package/g, @File);
grep($_ =~ s/BLOWFISH_KEY/$Blowfish_Key/g, @File);
print FILE @File;
## Get the Constants.pm module
open(FILE3,"$Main_Templates/Constants.pm"); my @File = ; close FILE3;
open(FILE,">$Home/Output/Perl/Constants.pm");
## Print the module out.
grep($_ =~ s/PACKAGE/$Package/g, @File);
grep($_ =~ s/DATABASE/$Database/g, @File);
grep($_ =~ s/TEMPDIR/$TempDir/g, @File);
grep($_ =~ s/WEB_ROOT/$Web_Root/g, @File);
print FILE @File;
## Get the Misc.pm module
open(FILE3,"$Main_Templates/Email.pm_header"); my @File = ; close FILE3;
open(FILE,">$Home/Output/Perl/Email.pm");
## Print the module out.
grep($_ =~ s/PACKAGE/$Package/g, @File);
print FILE @File;
open(FILE3,"$Perl_Module_Email_Custom"); my @File = ; close FILE3;
grep($_ =~ s/PACKAGE/$Package/g, @File);
print FILE @File;
print FILE "\n1;\n";
close FILE;
### Now copy the modules to their correct destination.
system "cp $Home/Output/Perl/*.pm $Destination_Modules/";
print "Copying: cp $Home/Output/Perl/*.pm $Destination_Modules/\n";
#--------------------------------------------------------------------------
### Now copy over the .htaccess and password file to the sample directory.
open(FILE3,"$Main_Templates/htaccess"); my @File3 = ; close FILE3;
open(FILE,">$Destination_Html/.htaccess");
grep($_ =~ s/DIR/$Destination_Html/g, @File3);
print FILE @File3;
close FILE;
system "cp $Main_Templates/Password $Destination_Html/";
system "cp $Main_Templates/Error_No_User.pl $Destination_Html/";
system "chmod 755 $Destination_Html/Error_No_User.pl";
#--------------------------------------------------------------------------
### Now create the sample Perl webpages/scripts.
my @Tables = (sort keys %$Table_Fields);
open(INDEX,">$Destination_Html/index.html");
print INDEX " Sample webpages for $Database \n\n";
foreach my $TableName (sort keys %$Table_Fields)
{
print INDEX " $TableName\.pl \n";
print "Creating sample webpage for '$TableName' at '$Destination_Html/$TableName\.pl'\n";
open(FILE3,"$Main_Templates/Custom_Html1.html");
my @Html = ; close FILE3;
open(FILE3,"$Main_Templates/Custom_Html1.html");
my @Html2 = ; close FILE3;
open(FILE,">$Destination_Html/$TableName\.pl");
grep($_ =~ s/PACKAGE/$Package/g, @Html);
grep($_ =~ s/TABLENAME/$TableName/g, @Html);
my $Ref = $Table_Fields->{$TableName};
my @Columns = (sort keys %$Ref);
## Create a list of columsn that do not end if "_id".
my @Columns_No_Ids = grep(!($_ =~ /_id$/), @Columns);
## Create a list of columsn that do end if "_id".
## Remember, as a standard, all fields that end in "_id" must have
## a table.
my @Columns_Ids = grep($_ =~ /_id$/, @Columns);
## Remove the current TABLENAME_id from that array
@Columns_Ids = grep(!($_ eq "$TableName\_id"), @Columns_Ids);
### Define the fields for updating and inserts.
my $DefineFields = "";
foreach my $Column (@Columns_No_Ids)
{$DefineFields .= " \$Fields->{'$Column'} = \$query->param('$Column');\n";}
foreach my $Column (@Columns_Ids)
{
my $Comment = "";
### We should uncomment this if we don't want them to change the users_id.
# if ($Column eq "users_id")
# {$Comment = " # We should turn off changing users_id.\n#";}
$DefineFields .= "$Comment \$Fields->{'$Column'} = \$Ids->{'$Column'};\n";
}
grep($_ =~ s/DEFINEFIELDS/$DefineFields/g, @Html);
### These few lines take care of the html rows for the table we are editing.
my $Html_Fields = "";
foreach my $Column (@Columns_No_Ids)
{
$Html_Fields .= qq($Column
; close FILE3;
my $Temp = $Column; $Temp =~ s/_id$//g;
grep($_ =~ s/TABLENAME/$Temp/g, @File3);
grep($_ =~ s/PACKAGE/$Package/g, @File3);
# grep($_ =~ s///, @File3);
my $Warning = " ## We did not detect a table for this id, disabling.\n";
if (exists $Table_Fields->{$Temp}) {$Warning = "";}
else { grep($_ = "#$_", @File3); unshift(@File3,$Warning);}
### Add template for column to other_lists.
$Other_Lists .= "@File3";
### This sets up decrypting the id for the column.
$OtherIds .= qq(\$Ids_Encrypted->{'$Column'} = \$query->param('$Column');
\$Ids->{'$Column'} = 0;
if (\$Ids_Encrypted->{'$Column'} ne "")
{\$Ids->{'$Column'} = PACKAGE::Misc->Decrypt(\$Ids_Encrypted->{'$Column'});}
);
$OtherIds_Set .= qq( \$Ids->{'$Column'} = \$$TableName\_Info->{'$Column'};
if (\$Ids->{'$Column'} < 0) {\$Ids->{'$Column'} = 0}
\$Ids_Encrypted->{'$Column'} = PACKAGE::Misc->Encrypt(\$Ids->{'$Column'});
\n);
### Get the column name from the column id, and other stuff.
my $Temp = $Column; $Temp =~ s/_id$//g;
my $Ref2 = $Table_Fields->{$Temp};
my @Columns2 = (sort keys %$Ref2);
$Html_Fields .= qq($Column
\$Other_Lists->{'$Column'}
Edit This Item
\n";
close INDEX;
#-------------------------------------------------------------------------
### Now create the java modules and java webpages
### TO DO
### Now create the php modules and php webpages
### TO DO
### Now create the python modules and python webpages
### TO DO
misc/nielsen/Test/Create_Functions.pl.txt~ 0100755 0000765 0000765 00000063137 07352327167 017703 0 ustar mark mark #!/usr/bin/perl
# Create Functions for Perl/PostgreSQL version 1.0
# Copyright 2001, Mark Nielsen
# All rights reserved.
# This Copyright notice was copied and modified from the Perl
# Copyright notice.
# This program is free software; you can redistribute it and/or modify
# it under the terms of either:
# a) the GNU General Public License as published by the Free
# Software Foundation; either version 1, or (at your option) any
# later version, or
# b) the "Artistic License" which comes with this Kit.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either
# the GNU General Public License or the Artistic License for more details.
# You should have received a copy of the Artistic License with this
# Kit, in the file named "Artistic". If not, I'll be glad to provide one.
# You should also have received a copy of the GNU General Public License
# along with this program in the file named "Copying". If not, write to the
# Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
# 02111-1307, USA or visit their web page on the internet at
# http://www.gnu.org/copyleft/gpl.html.
use strict;
### Verify that we are connecting to the correct database.
my @List = @ARGV;
my $Database = shift @List;
my $Table = $List[0];
system "clear";
if ($Database eq "")
{print "No database specified, not doing anything.\n"; exit;}
my $Message="We are going to delete and create all tables for '$Database'.\n";
if ($Table ne "")
{$Message = "We are going to delete and create the table '$Table'.\n";}
print "We are going to connect to the database '$Database'.\n";
print $Message;
print "Type 'y' for yes or 'n' for no and press enter.\n";
my $R = ; chomp $R;
if ($R =~ /n/i) {exit;}
elsif (!($R =~ /y/i)) {exit;}
### We want to define some variables WHICH YOU SHOULD CHANGE FOR YOUR
### OWN COMPUTER.
### These two variables are defined by general configuration.
my $Pre_Home = "/var/www/html/database";
my $Server_Root = "/usr/local/apache";
### Now grab any local configuration for this database.
### We should put a check in here detecting if we are executing in the
### directory that this script is in.
if (!(-e "Config.txt"))
{
print "Error, no Config.txt file. Aborting. We need the main Config.txt file to be defined.\n";
exit;
}
### Now load the file, parse it, and assign variables.
open(FILE,"Config.txt"); my @File = ; close FILE;
grep(chomp $_, @File);
@File = grep($_ =~ /[a-z0-9]/i, @File);
grep($_ =~ s/\t/ /g, @File);
grep($_ =~ s/^ +//g, @File);
grep($_ =~ s/ +$//g, @File);
@File = grep(!($_ =~ /\#/), @File); # Delete any lines with '#' in them.
foreach my $Line (@File)
{
my ($Key,$Value) = split(/ /, $Line, 2);
if ($Key eq "PRE_HOME") {$Pre_Home = $Value;}
elsif ($Key eq "SERVER_ROOT") {$Server_Root = $Value;}
# print "$Key = $Value\n";
}
### We should put a chdir command here to force us to the right directory.
### These 4 variables are defined by the database. Create the directory.
if (!(-e "$Pre_Home/$Database"))
{
system "mkdir -p $Pre_Home/$Database/Output/Tables";
system "mkdir -p $Pre_Home/$Database/Output/Perl/HTML";
system "mkdir -p $Pre_Home/$Database/Custom/Perl";
system "mkdir -p $Pre_Home/$Database/Custom/Sql";
system "mkdir -p $Pre_Home/$Database/Backups";
}
my $Package = "SAMPLE_DATABASE";
my $Blowfish_Key = "MAI BLOWFISH KEY 123456789012345";
my $Destination_Html = "$Server_Root/htdocs_ges/sample/$Database";
my $Destination_Modules = "$Server_Root/lib/perl/SAMPLE_DATABASE";
my $TempDir = "/tmp/temp_dir";
my $Web_Root = "$TempDir";
### Now grab any local configuration for this database.
if (!(-e "$Pre_Home/$Database/Config.txt"))
{
print "Error, no Config.txt file. Aborting.\n We need the file\n$Pre_Home/$Database/Config.txt\n to be defined.\n";
exit;
}
### Now load the file, parse it, and assign variables.
open(FILE,"$Pre_Home/$Database/Config.txt"); my @File = ; close FILE;
grep(chomp $_, @File); ## delete newlines.
@File = grep($_ =~ /[a-z0-9]/i, @File); ## Delete blank lines.
grep($_ =~ s/\t/ /g, @File); # Convert tabs to spaces.
grep($_ =~ s/^ +//g, @File); # Delete beginning spaces.
grep($_ =~ s/ +$//g, @File); # Delete ending spaces.
@File = grep(!($_ =~ /\#/), @File); # Delete any lines with '#' in them.
foreach my $Line (@File)
{
my ($Key,$Value) = split(/ /, $Line, 2);
if ($Key eq "BLOWFISH_KEY") {$Blowfish_Key = $Value;}
elsif ($Key eq "DESTINATION_HTML") {$Destination_Html = $Value;}
elsif ($Key eq "DESTINATION_MODULES") { $Destination_Modules = $Value;}
elsif ($Key eq "PACKAGE") { $Package = $Value;}
elsif ($Key eq "TEMPDIR") { $TempDir = $Value;}
elsif ($Key eq "WEB_ROOT") { $Web_Root = $Value;}
else {print "Uknown configuration, aborting. $Key = $Value\n"; exit;}
}
## Make the directories if they don't exist.
if (!(-e $Destination_Html)) {system "mkdir -p $Destination_Html";}
if (!(-e $Destination_Modules)) {system "mkdir -p $Destination_Modules";}
if (!(-e $TempDir)) {system "mkdir -p $TempDir";}
### Variables after this point should not be touched.
### Define all the variables for the Perl script
my $Home = "$Pre_Home/$Database";
my $File = "$Home/Tables.txt";
### I don't think I use the $TempFile anywhere. For future use.
my $TempFile = "$Home/Tempfile.txt";
my $Main_Templates = "$Pre_Home/Templates";
my $SQL_Template = "$Main_Templates/Generic.fun";
my $SQL_Custom = "$Main_Templates/Custom.sql";
my $Perl_Module_Set_Header = "$Main_Templates/Set_Info.pm_header";
my $Perl_Module_Set_Template = "$Main_Templates/Set_Info.pm_template";
my $Perl_Module_Get_Header = "$Main_Templates/Get_Info.pm_header";
### Define all the variables for this database
my $Templates = "$Home";
my $Perl_Module_Set_Output = "$Home/Output/Perl/Set_Info.pm";
my $Perl_Module_Set_Custom = "$Templates/Custom/Perl/Set_Info.pm_custom";
my $Perl_Module_Get_Output = "$Home/Output/Perl/Get_Info.pm";
my $Perl_Module_Get_Custom = "$Templates/Custom/Perl/Get_Info.pm_custom";
my $Perl_Module_Email_Custom = "$Templates/Custom/Perl/Email.pm_custom";
#------------------------------------------------------------------------
## Let us create the directories we need if they are not there.
if (!(-e "$Home")) {system "mkdir -p $Home";}
if (!(-e "$Home/Output/Tables")) {system "mkdir -p $Home/Output/Tables"}
if (!(-e "$Home/Backups")) {system "mkdir -p $Home/Backups"}
if (!(-e "$Home/Custom")) {system "mkdir -p $Home/Custom"}
if (!(-e "$Home/Output/Perl/HTML")) {system "mkdir -p $Home/Output/Perl/HTML"}
## Of course, I haven't done the php, java, python stuff, but
## I want to set it up so that it is obvious how i want to do it.
if (!(-e "$Home/Output/Php/HTML")) {system "mkdir -p $Home/Output/Php/HTML"}
if (!(-e "$Home/Output/Python/HTML"))
{system "mkdir -p $Home/Output/Python/HTML"}
if (!(-e "$Home/Output/Java/HTML")) {system "mkdir -p $Home/Output/Java/HTML"}
### Open up the template for the functions and the file that contains
### the info to create the tables.
### If the file with tables doesn't exit, abort.
if (!(-e "$Home/Tables.txt"))
{print "Error, $Home/Tables.txt does not exist, aborting.\n"; exit;}
open(FILE,$SQL_Template); my @SQL_Template = ; close FILE;
open(FILE,$File); my @File = ; close FILE;
open(FILE,$SQL_Custom); my @SQL_Custom = ; close FILE;
open(FILE,$Perl_Module_Set_Template); my @Perl_S_T = ; close FILE;
### Filter out lines that have no numbers or letters.
@File = grep($_ =~ /[a-z0-9]/i, @File);
### Get rid of any line which contains a #
@File = grep(!($_ =~ /\#/), @File);
### Get rid of the newline.
grep(chomp $_, @File);
### Get rid of tabs and replace with spaces. .
grep($_ =~ s/\t/ /g, @File);
### Convert all multiple spaces to one.
grep($_ =~ s/ +/ /g, @File);
### Next two lines get rid of spaces and front and end.
grep($_ =~ s/^ //g, @File);
grep($_ =~ s/ $//g, @File);
### Delete any commas at the end, we will put them back on later.
grep($_ =~ s/\,+$//g, @File);
my $Tables = {};
my $Table_Fields = {};
my $TableName = "";
### For each line in the file, either make a new array for the table,
### or store the lines in the array for a table.
foreach my $Line (@File)
{
my $Junk = "";
### If the line starts with "TABLENAME" then create a new array.
if ($Line =~ /^TABLENAME/)
{
($Junk,$TableName, $Junk) = split(/ /,$Line);
### This creates the aray for the table.
$Tables->{$TableName} = [];
$Table_Fields->{$TableName} = {};
}
else
{
### Storing lines for the table.
push (@{$Tables->{$TableName}}, $Line) ;
### This part is redundant, but we need this info.
my ($Name,$Type,$Ext) = split(/ /,$Line,3);
## Backup field names for Perl and other Scripts.
$Table_Fields->{$TableName}->{$Name} = "$Type $Ext";
}
}
my @Table_List = sort keys %$Tables;
### If we listed specific tables, then only do those.
if (@List)
{
foreach my $TableName (sort keys %$Tables)
{
if (!(grep($_ eq $TableName, @List)))
{@Table_List = grep($_ ne $TableName, @Table_List);}
}
}
### Get the keys of the reference to an array $Tables
### and get the data for that array, create our file, and then use the file.
foreach my $TableName (@Table_List)
{
## Create a temporary array which contains the table definitions
my @Temp = @{$Tables->{$TableName}};
my $Backup_Columns = ""; my $Backup_Values = ""; my $Update_Fields = "";
my $Field_Copy_Values = ""; my $FieldTypes = "";
my $CleanVariables = ""; my $RemakeVariables = "";
### The two tables are different in one respect, the backup table
### does not require uniqueness and it doesn't use a sequence.
my $Table = qq($TableName\_id int4 NOT NULL PRIMARY KEY DEFAULT nextval('$TableName\_sequence'),
date_updated timestamp NOT NULL default CURRENT_TIMESTAMP,
date_created timestamp NOT NULL default CURRENT_TIMESTAMP,
active int2 CHECK (active in (0,1)) DEFAULT 0,
);
## I should allow null for the id instead of 0, but since the sequence
### starts at 1, I use 0 as null. I hate nulls.
my $Table_Backup = qq(backup_id int4 NOT NULL UNIQUE DEFAULT nextval('$TableName\_sequence_backup'),
$TableName\_id int4 NOT NULL DEFAULT 0,
date_updated timestamp NOT NULL default CURRENT_TIMESTAMP,
date_created timestamp NOT NULL default CURRENT_TIMESTAMP,
active int2 CHECK (active in (0,1)) DEFAULT 0,
);
print "Creating functions for table '$TableName'\n";
my $No = 1;
### For each line for this table do this.
### We want to create a few variables that are going to be placed into
### the template.
my $Fields = "";
## Foreach line in the table definition
foreach my $Line (@Temp)
{
my ($Name,$Type,$Ext) = split(/ /,$Line,3);
### Detect if name ends in "_id", and if so, add forieng keys constraint.
my $Additional = "";
if ($Name =~ /_id$/)
{
my $TableName = $Name; $TableName =~ s/_id$//g;
### ON DELETE NO ACTION and FORIEGN KEY ($Name) are not needed,
### but I want to be explicit what I am doing.
$Additional = qq( REFERENCES $TableName
ON DELETE NO ACTION
ON UPDATE CASCADE );
}
$Table .= "$Line $Additional,\n";
$Table_Backup .= "$Line $Additional,\n";
### Make an array of the fields.
$Fields .= "'$Name',";
### The backup columns
$Backup_Columns .= ", $Name";
### The update fields
$No++; $Update_Fields .= ", $Name = var_$No";
### Backup values
$Backup_Values .= ", record_backup.$Name";
### Now the fields when we copy stuff in the cyop function.
$Field_Copy_Values .= ", clean_text(record2.$Name)";
### Now the field types for the update function.
$FieldTypes .= ", $Type";
### We need to define the variables for the updating function.
$CleanVariables .= " var_$No $Type;\n";
### We need to define the type, I only check for text and int4 for now.
my $Temp = "\$$No";
if ($Type eq "int4") {$Temp = "clean_numeric($Temp)";}
elsif ($Type eq "text") {$Temp = "clean_text($Temp)";}
### Now we need to set the variables.
$RemakeVariables .= " var_$No := $Temp;\n";
### We also need to add the function to clean out the variables before
### they are submitted.
}
### Chop off the last comma for $Fields;
chop $Fields;
### Record how many rows we had. Make a line for the update command for
### testing.
my $Number_Of_Rows = $No;
my $Update_Test = "1";
for (my $i = 1; $i < $Number_Of_Rows - 1; $i++) {$Update_Test .= ",$i";}
### We need to chop off the last comma.
chomp $Table; chop $Table; chomp $Table_Backup; chop $Table_Backup;
### Now let us setup dropping and creating of the table and backup table.
my $Tables = qq(drop table $TableName;\ncreate table $TableName (\n$Table\n););
$Tables .= "drop table $TableName\_backup;\n";
$Tables .= "create table $TableName\_backup (\n$Table_Backup, error_code text NOT NULL DEFAULT ''\n);\n";
### Let us create a view for active stuff in our table.
$Tables .= "drop view $TableName\_active;\n";
$Tables .= "create view $TableName\_active as select * from $TableName
where active = 1;\n";
### Create a view for inactive or deleted items.
$Tables .= "drop view $TableName\_deleted;\n";
$Tables .= "create view $TableName\_deleted as select * from $TableName
where active = 0;\n";
### Create a view for a list of unique backup ids.
$Tables .= "drop view $TableName\_backup_ids;\n";
$Tables .= "create view $TableName\_backup_ids as
select distinct $TableName\_id from $TableName\_backup;\n";
### Create a list of purged data (lastest data per id).
$Tables .= "drop view $TableName\_purged;\n";
$Tables .= "create view $TableName\_purged as
select * from $TableName\_backup where oid = ANY (
select max(oid) from $TableName\_backup where $TableName\_id = ANY
(
select distinct $TableName\_id from $TableName\_backup
where $TableName\_backup.error_code = 'purge'
and NOT $TableName\_id = ANY (select $TableName\_id from $TableName)
)
group by $TableName\_id
)
;\n";
### I use grep commands to search and replace stuff for arrays.
### I could use map, but I like greps.
my @Temp = @SQL_Template;
push (@Temp,@SQL_Custom);
## Now, if there is a custom made file for this table, add it.
if (-e "$Home/Custom/Sql/$TableName\.sql")
{
open(FILE,"$Home/Custom/Sql/$TableName\.sql"); my @Temp2 = ; close FILE;
push (@Temp,@Temp2);
}
grep($_ =~ s/TABLENAME/$TableName/g, @Temp);
grep($_ =~ s/BACKUPCOLUMNS/$Backup_Columns/g, @Temp);
grep($_ =~ s/BACKUPVALUES/$Backup_Values/g, @Temp);
grep($_ =~ s/UPDATEFIELDS/$Update_Fields/g, @Temp);
grep($_ =~ s/COPYFIELDS/$Field_Copy_Values/g, @Temp);
grep($_ =~ s/FIELDS/$FieldTypes/g, @Temp);
grep($_ =~ s/HOME/$Home/g, @Temp);
grep($_ =~ s/CLEANVARIABLES/$CleanVariables/g, @Temp);
grep($_ =~ s/REMAKEVARIABLES/$RemakeVariables/g, @Temp);
### Now move the stuff from the array @Temp to @Template_Copy.
my @Template_Copy = @Temp;
### Now we save the file. We won't delete it (unless you run this script
### again) so that we can figure out what was done.
open(FILE,">$Home/Output/Tables/$TableName\.table_functions");
### Create the sequence for the table .
print FILE "drop sequence $TableName\_sequence;\n";
print FILE "create sequence $TableName\_sequence;\n";
print FILE "drop sequence $TableName\_sequence_backup;\n";
print FILE "create sequence $TableName\_sequence_backup;\n";
### Print out the table and backup table.
print FILE $Tables;
### Print out the 4 functions, insert, delete, update, and copy.
foreach my $Temp (@Template_Copy) {print FILE "$Temp";}
### Print out a vaccum command.
print FILE "vacuum;\n";
close FILE;
### Before we execute, let us backup the table in case some novice
### executes this on a live server.
my $Backup_File = "$Home/Backups/$TableName\_0.backup";
my $No = 0;
while (-e $Backup_File)
{$No++; $Backup_File = "$Home/Backups/$TableName\_$No\.backup";}
### Now we have the filename to store the backup, execute it.
system ("pg_dump -t $TableName -f $Backup_File $Database");
### Uncomment this option if you want to see what is in the file.
## system ("cat $Home/Output/Tables/$TableName\.table_functions");
### Drop table and functions, create table and functions and backup table.
system ("psql -d $Database -c '\\i $Home/Output/Tables/$TableName\.table_functions'");
print "Check the file\n $Home/Output/Tables/$TableName\.table_functions.\n";
## Now, add a custom made file for perl.
open(FILE,">$Home/Output/Perl/$TableName\.pl");
my @Temp_Perl = @Perl_S_T;
grep($_ =~ s/TABLENAME/$TableName/g, @Temp_Perl);
grep($_ =~ s/BACKUPCOLUMNS/$Backup_Columns/g, @Temp_Perl);
grep($_ =~ s/BACKUPVALUES/$Backup_Values/g, @Temp_Perl);
grep($_ =~ s/UPDATEFIELDS/$Update_Fields/g, @Temp_Perl);
grep($_ =~ s/COPYFIELDS/$Field_Copy_Values/g, @Temp_Perl);
grep($_ =~ s/FIELDS/$FieldTypes/g, @Temp_Perl);
grep($_ =~ s/HOME/$Home/g, @Temp_Perl);
grep($_ =~ s/CLEANVARIABLES/$CleanVariables/g, @Temp_Perl);
grep($_ =~ s/REMAKEVARIABLES/$RemakeVariables/g, @Temp_Perl);
grep($_ =~ s/LISTCOLUMNS/$Fields/g, @Temp_Perl);
print FILE @Temp_Perl;
close FILE;
}
#---------------------------------------------------------------------------
#### Perl modules and Perl webpages.
## Load the Perl module header;
open(FILE3,$Perl_Module_Set_Header); my @File = ; close FILE3;
## Gather all the perl scripts we have made.
my @Files = <$Home/Output/Perl/*.pl>;
## Open up the new perl module
open(FILE,">$Perl_Module_Set_Output");
## Print the header to the module
grep($_ =~ s/PACKAGE/$Package/g, @File);
print FILE @File;
## One by one, print the subroutines to the module.
## Also, store the tablenames into an array
my @Get_Info_Array = ();
foreach my $File (@Files)
{
open(FILE2,$File); my @File2 = ; close FILE2;
print FILE @File2;
my (@Temp) = split(/\//, $File);
my $Last = pop @Temp;
my ($Name,$Junk) = split(/\./,$Last,2);
push (@Get_Info_Array,$Name);
}
### Get the custom stuff and append it.
open(FILE3,$Perl_Module_Set_Custom); my @File = ; close FILE3;
print FILE @File;
## Return true for the module.
print FILE "\n1;\n";
close FILE;
### Now create the Get_Info.pm module
my $Valid_Tables = "";
foreach my $Table (@Get_Info_Array)
{$Valid_Tables .= " '$Table',";}
chop $Valid_Tables;
## Load the Perl module header;
open(FILE3,$Perl_Module_Get_Header); my @File = ; close FILE3;
## Open up the new perl module
open(FILE,">$Perl_Module_Get_Output");
## Print the header to the module
grep($_ =~ s/PACKAGE/$Package/g, @File);
grep($_ =~ s/VALIDTABLES/$Valid_Tables/g, @File);
print FILE @File;
## Get the custom made stuff and append it.
open(FILE3,$Perl_Module_Get_Custom); my @File = ; close FILE3;
print FILE @File;
## Return true for the module.
print FILE "\n1;\n";
close FILE;
## Get the Misc.pm module
open(FILE3,"$Main_Templates/Misc.pm"); my @File = ; close FILE3;
open(FILE,">$Home/Output/Perl/Misc.pm");
## Print the module out.
grep($_ =~ s/PACKAGE/$Package/g, @File);
grep($_ =~ s/BLOWFISH_KEY/$Blowfish_Key/g, @File);
print FILE @File;
## Get the Constants.pm module
open(FILE3,"$Main_Templates/Constants.pm"); my @File = ; close FILE3;
open(FILE,">$Home/Output/Perl/Constants.pm");
## Print the module out.
grep($_ =~ s/PACKAGE/$Package/g, @File);
grep($_ =~ s/DATABASE/$Database/g, @File);
grep($_ =~ s/TEMPDIR/$TempDir/g, @File);
grep($_ =~ s/WEB_ROOT/$Web_Root/g, @File);
print FILE @File;
## Get the Misc.pm module
open(FILE3,"$Main_Templates/Email.pm_header"); my @File = ; close FILE3;
open(FILE,">$Home/Output/Perl/Email.pm");
## Print the module out.
grep($_ =~ s/PACKAGE/$Package/g, @File);
print FILE @File;
open(FILE3,"$Perl_Module_Email_Custom"); my @File = ; close FILE3;
grep($_ =~ s/PACKAGE/$Package/g, @File);
print FILE @File;
print FILE "\n1;\n";
close FILE;
### Now copy the modules to their correct destination.
system "cp $Home/Output/Perl/*.pm $Destination_Modules/";
print "Copying: cp $Home/Output/Perl/*.pm $Destination_Modules/\n";
#--------------------------------------------------------------------------
### Now copy over the .htaccess and password file to the sample directory.
open(FILE3,"$Main_Templates/htaccess"); my @File3 = ; close FILE3;
open(FILE,">$Destination_Html/.htaccess");
grep($_ =~ s/DIR/$Destination_Html/g, @File3);
print FILE @File3;
close FILE;
system "cp $Main_Templates/Password $Destination_Html/";
system "cp $Main_Templates/Error_No_User.pl $Destination_Html/";
system "chmod 755 $Destination_Html/Error_No_User.pl";
#--------------------------------------------------------------------------
### Now create the sample Perl webpages/scripts.
my @Tables = (sort keys %$Table_Fields);
open(INDEX,">$Destination_Html/index.html");
print INDEX " Sample webpages for $Database \n\n";
foreach my $TableName (sort keys %$Table_Fields)
{
print INDEX " $TableName\.pl \n";
print "Creating sample webpage for '$TableName' at '$Destination_Html/$TableName\.pl'\n";
open(FILE3,"$Main_Templates/Custom_Html1.html");
my @Html = ; close FILE3;
open(FILE3,"$Main_Templates/Custom_Html1.html");
my @Html2 = ; close FILE3;
open(FILE,">$Destination_Html/$TableName\.pl");
grep($_ =~ s/PACKAGE/$Package/g, @Html);
grep($_ =~ s/TABLENAME/$TableName/g, @Html);
my $Ref = $Table_Fields->{$TableName};
my @Columns = (sort keys %$Ref);
## Create a list of columsn that do not end if "_id".
my @Columns_No_Ids = grep(!($_ =~ /_id$/), @Columns);
## Create a list of columsn that do end if "_id".
## Remember, as a standard, all fields that end in "_id" must have
## a table.
my @Columns_Ids = grep($_ =~ /_id$/, @Columns);
## Remove the current TABLENAME_id from that array
@Columns_Ids = grep(!($_ eq "$TableName\_id"), @Columns_Ids);
### Define the fields for updating and inserts.
my $DefineFields = "";
foreach my $Column (@Columns_No_Ids)
{$DefineFields .= " \$Fields->{'$Column'} = \$query->param('$Column');\n";}
foreach my $Column (@Columns_Ids)
{
my $Comment = "";
### We should uncomment this if we don't want them to change the users_id.
# if ($Column eq "users_id")
# {$Comment = " # We should turn off changing users_id.\n#";}
$DefineFields .= "$Comment \$Fields->{'$Column'} = \$Ids->{'$Column'};\n";
}
grep($_ =~ s/DEFINEFIELDS/$DefineFields/g, @Html);
### These few lines take care of the html rows for the table we are editing.
my $Html_Fields = "";
foreach my $Column (@Columns_No_Ids)
{
$Html_Fields .= qq($Column
; close FILE3;
my $Temp = $Column; $Temp =~ s/_id$//g;
grep($_ =~ s/TABLENAME/$Temp/g, @File3);
grep($_ =~ s/PACKAGE/$Package/g, @File3);
# grep($_ =~ s///, @File3);
my $Warning = " ## We did not detect a table for this id, disabling.\n";
if (exists $Table_Fields->{$Temp}) {$Warning = "";}
else { grep($_ = "#$_", @File3); unshift(@File3,$Warning);}
### Add template for column to other_lists.
$Other_Lists .= "@File3";
### This sets up decrypting the id for the column.
$OtherIds .= qq(\$Ids_Encrypted->{'$Column'} = \$query->param('$Column');
\$Ids->{'$Column'} = 0;
if (\$Ids_Encrypted->{'$Column'} ne "")
{\$Ids->{'$Column'} = PACKAGE::Misc->Decrypt(\$Ids_Encrypted->{'$Column'});}
);
$OtherIds_Set .= qq( \$Ids->{'$Column'} = \$$TableName\_Info->{'$Column'};
if (\$Ids->{'$Column'} < 0) {\$Ids->{'$Column'} = 0}
\$Ids_Encrypted->{'$Column'} = PACKAGE::Misc->Encrypt(\$Ids->{'$Column'});
\n);
### Get the column name from the column id, and other stuff.
my $Temp = $Column; $Temp =~ s/_id$//g;
my $Ref2 = $Table_Fields->{$Temp};
my @Columns2 = (sort keys %$Ref2);
$Html_Fields .= qq($Column
\$Other_Lists->{'$Column'}
Edit This Item
\n";
close INDEX;
#-------------------------------------------------------------------------
### Now create the java modules and java webpages
### TO DO
### Now create the php modules and php webpages
### TO DO
### Now create the python modules and python webpages
### TO DO