i use the relational db hack extensively to do things like this. here's an example. i have a recipe database that has recipe title and description. then i have another db that has the ingredients. each record in ingredients has a recipeID field to relate back to the recipe. in the place in the recipe db where i want to list the ingredients i have the following:
Code:
sub switch_to_ingredients {
#-----------------------------------------------------
undef @db2_cols;
$configfile = "$_[0].def";
&get_fieldnames2($configfile);
$db2_file_name = $db_script_path . "/ingredients.db";
$db2_key_pos = 0;
$db2_delim = '|'; # 3/17/2009
}
sub get_fieldnames2 {
#-----------------------------------------------------
# pulls field names from the def file!
# check def file to be sure field names enclosed in single quotes!
#$configfile = "$_[0].def";
$configfile = $db_script_path . "/" . $configfile;
open(FILE, "<$configfile") || &cgierr("Cannot open $configfile.\n$!");
local $/;
my ($fields);
while (<FILE>) { if (/(%db_def\s+=\s+\(\s+)('.*?)(\);)/s) { $fields = $2;}}
close(FILE);
my @split = split /\n/, $fields;
foreach (@split) {
if ($_ =~ /'(\w+)'/) { push @db2_cols, $1; }
}
sub get_record2 {
# --------------------------------------------------------
# Given an ID as input, get_record returns a hash of the
# requested record or undefined if not found.
my ($key2, $found, $line, @data, $field, $restricted);
my ($notfound);
$key2 = $_[0];
$found = 0;
# spambuster hack delicia comment next line
# ($restricted = 1) if ($auth_modify_own and !$per_admin);
open (DBX, "<$db2_file_name") or &cgierr("error in get_records. unable to open db file: $db2_file_name.\nReason: $!");
flock(DBX, 1);
LINE: while (<DBX>) {
(/^#/) and next LINE;
(/^\s*$/) and next LINE;
$line = $_;
chomp ($line);
@data = &split_decode2($line);
#next LINE if ($restricted and ($db_userid ne $data[$auth_user_field]));
if ($data[$db2_key_pos] eq $key2) {
$found = 1;
for ($j = 0; $j <= $#db2_cols; $j++) { # Map the array columns to a hash.
$rec2{$db2_cols[$j]} = $data[$j];
}
last LINE;
}
$notfound .= $data[$db2_key_pos] ;
}
close DBX;
$found ?
(return %rec2) :
(return undef);
# $found ?
# (return %rec2) :
# (return $notfound);
#
}
##########################################################
sub split_decode2 {
# --------------------------------------------------------
# Takes one line of the database as input and returns an
# array of all the values. It replaces special mark up that
# join_encode makes such as replacing the '``' symbol with a
# newline and the '~~' symbol with a database delimeter.
my ($input) = shift;
$input =~ s/\Q$db2_delim\E$/$db2_delim /o; # Add a space if we have delimiter new line.
my (@array) = split (/\Q$db2_delim\E/o, $input);
for ($j = 0; $j <= $#array; $j++) {
$array[$j] =~ s/~~/$db2_delim/og; # Retrieve Delimiter..
$array[$j] =~ s/``/\n/g; # Change '' back to newlines..
}
return @array;
}
##########
sub query2 {
# --------------------------------------------------------
# First let's get a list of database fields we want to search on and
# store it in @search_fields
my ($i, $column, @search_fields, @search_gt_fields, @search_lt_fields, $maxhits, $numhits, $nh,
$field, @regexp, $line, @values, $key_match, @hits, @sortedhits, $next_url, $next_hit, $prev_hit,
$first, $last, $upper, $lower, $left, $right, $restricted);
my ($numrecs);
# local (%sortby);
local (%sortby1);
local (%sortby2);
local (%sortby3);
$in{'sb1'} = (($in{'sb1'}) ? $in{'sb1'} : $sortfield1 );
$in{'sb2'} = (($in{'sb2'}) ? $in{'sb2'} : $sortfield2 );
$in{'sb3'} = (($in{'sb3'}) ? $in{'sb3'} : $sortfield3 );
$in{'so1'} = (($in{'so1'}) ? $in{'so1'} : $sortorder1 );
$in{'so2'} = (($in{'so2'}) ? $in{'so2'} : $sortorder2 );
$in{'so3'} = (($in{'so3'}) ? $in{'so3'} : $sortorder3 );
########## multiword keyword search
if ($in{'keyword'} =~ / /) {
$in{'keyword'} =~ s/ /|/g;
$in{'re'} = 1;
}
###########
######## delicia hack
### two different possibilities for showing validated records
### first one below shows unvalidated records to admin only
### second one shows to anyone who is logged in
### use admin_only flag in cfg to choose which <----------
######## end validated records hacks
# First thing we do is find out what we are searching for. We build a list of fields
# we want to search on in @search_fields.
if ($in{'keyword'}) { # If this is a keyword search, we are searching the same
$i = 0; # thing in all fields. Make sure "match any" option is
$in{'ma'} = "on"; # on, otherwise this will almost always fail.
foreach $column (@db2_cols) {
# if (($db_sort{$column} eq 'date') or &date_to_unix($in{'keyword'})) { $i++; next; }
# if ($i == $auth_user_field) { $i++; next; } #10/1/2008 comment this line to find users in keyword box
push (@search_fields, $i); # Search every column
$in{$column} = $in{'keyword'}; # Fill %in with keyword we are looking for.
$i++;
}
}
else {
$i = 0; # that match everything the user specified for.
foreach $column (@db2_cols) {
# if ($in{$column} =~ /^\>(.+)$/) { ($db_sort{$column} eq 'date') and (&date_to_unix($1) or return "Invalid date format: '$1'");
# push (@search_gt_fields, $i); $in{"$column-gt"} = $1; $i++; next; }
# if ($in{$column} =~ /^\<(.+)$/) { ($db_sort{$column} eq 'date') and (&date_to_unix($1) or return "Invalid date format: '$1'");
# push (@search_lt_fields, $i); $in{"$column-lt"} = $1; $i++; next; }
if ($in{$column} !~ /^\s*$/) {
# if ($db_sort{$column} eq 'date') {
# if (&date_to_unix($in{$column})) {
# $in{$column} = &get_computed_date(&date_to_unix($in{$column}));
# }
# else {
# return "Invalid date format: '$in{$column}'";
# }
# }
push(@search_fields, $i); $i++; next;
}
if ($in{"$column-gt"} !~ /^\s*$/) { ($db_sort{$column} eq 'date') and (&date_to_unix($in{"$column-gt"}) or return qq|Invalid date format: '$in{"$column-gt"}'|);
push(@search_gt_fields, $i); }
if ($in{"$column-lt"} !~ /^\s*$/) { ($db_sort{$column} eq 'date') and (&date_to_unix($in{"$column-lt"}) or return qq|Invalid date format: '$in{"$column-lt"}'|);
push(@search_lt_fields, $i); }
$i++;
}
}
# If we don't have anything to search on, let's complain.
if (!@search_fields and !@search_gt_fields and !@search_lt_fields) {
return "no search terms specified";
}
# Define the maximum number of hits we will allow, and the next hit counter.
if ($_[0] eq "multimod" || $_[0] eq "mod") { $in{'mh'} = 9999; } #3/4/2008 6/13/2009 mod so delete/mod will list all
$in{'mh'} ? ($maxhits = $in{'mh'}) : ($maxhits = $db_max_hits);
$in{'nh'} ? ($nh = $in{'nh'}) : ($nh = 1);
$numhits = 0;
# Now let's build up all the regexpressions we will use. This saves the program
# from having to recompile the same regular expression every time.
foreach $field (@search_fields) {
my $tmpreg = "$in{$db2_cols[$field]}";
(!$in{'re'}) and ($tmpreg = "\Q$tmpreg\E");
($in{'ww'}) and ($tmpreg = "\\b$tmpreg\\b");
(!$in{'cs'}) and ($tmpreg = "(?i)$tmpreg");
# ($in{$db2_cols[$field]} eq "*") and ($tmpreg = ".*"); # A "*" matches anything.
unless ($db_userid eq "default" && !$searchall) {
($in{$db2_cols[$field]} eq "*") and ($tmpreg = ".*"); # A "*" matches anything.
}
$regexp_func[$field] = eval 'sub { m/$tmpreg/o; }';
$regexp_bold[$field] = $tmpreg;
}
# Now we go through the database and do the actual searching.
# First figure out which records we want:
$first = ($maxhits * ($nh - 1));
$last = $first + $maxhits - 1;
open (DBX, "<$db2_file_name") or &cgierr("error in search. unable to open database: $db2_file_name.\nReason: $!");
if ($db_use_flock) { flock(DBX, 1); }
LINE: while (<DBX>) {
(/^#/) and next LINE; # Skip comment Lines.
(/^\s*$/) and next LINE; # Skip blank lines.
$line = $_; chomp ($line); # Remove trailing new line.
@values = &split_decode2($line);
# Normal searches.
$key_match = 0;
foreach $field (@search_fields) {
$_ = $values[$field]; # Reg function works on $_.
$in{'ma'} ?
($key_match = ($key_match or &{$regexp_func[$field]})) :
(&{$regexp_func[$field]} or next LINE);
}
# Greater then searches.
foreach $field (@search_gt_fields) {
$term = $in{"$db2_cols[$field]-gt"};
if ($db_sort{$db2_cols[$field]} eq "date") { # 12/20/2009 delicia
my ($dd1) = &date_to_unix($values[$field]);
my ($dd2) = &date_to_unix($term); --$dd2;
$in{'ma'} ? ($key_match = ($key_match or ($dd1 > $dd2))) : (($dd1 > $dd2) or next LINE);
}
elsif ($db_sort{$db_cols[$field]} eq 'alpha') {
$in{'ma'} ?
($key_match = ($key_match or ($values[$field] > $term))) :
((lc($values[$field]) gt lc($term)) or next LINE);
}
else {
$in{'ma'} ?
($key_match = ($key_match or ($values[$field] > $term))) :
(($values[$field] > $term) or next LINE);
}
}
# Less then searches.
foreach $field (@search_lt_fields) {
$term = $in{"$db2_cols[$field]-lt"};
if ($db_sort{$db2_cols[$field]} eq "date") { # 12/20/2009 delicia
my ($dd1) = &date_to_unix($values[$field]);
my ($dd2) = &date_to_unix($term); ++$dd2;
$in{'ma'} ? ($key_match = ($key_match or ($dd1 < $dd2))) : (($dd1 < $dd2) or next LINE);
}
elsif ($db_sort{$db2_cols[$field]} eq 'alpha') {
$in{'ma'} ?
($key_match = ($key_match or ($values[$field] < $term))) :
((lc($values[$field]) lt lc($term)) or next LINE);
}
else {
$in{'ma'} ?
($key_match = ($key_match or ($values[$field] < $term))) :
(($values[$field] < $term) or next LINE);
}
}
# Did we find a match? We only add the hit to the @hits array if we need it. We can
# skip it if we are not sorting and it's not in our first < > last range.
if ($key_match || (!($in{'keyword'}) && !($in{'ma'}))) {
##### hack for sorting on 3 fields
if (exists $in{'sb1'} && exists $in{'sb2'} && exists $in{'sb3'}) {
$sortby1{(($#hits+1) / ($#db2_cols+1))} = $values[$in{'sb1'}];
$sortby2{(($#hits+1) / ($#db2_cols+1))} = $values[$in{'sb2'}];
$sortby3{(($#hits+1) / ($#db2_cols+1))} = $values[$in{'sb3'}];
push (@hits, @values);
}
elsif (exists $in{'sb1'} && exists $in{'sb2'}) {
$sortby1{(($#hits+1) / ($#db2_cols+1))} = $values[$in{'sb1'}];
$sortby2{(($#hits+1) / ($#db2_cols+1))} = $values[$in{'sb2'}];
push (@hits, @values);
}
elsif (exists $in{'sb1'}) {
$sortby1{(($#hits+1) / ($#db2_cols+1))} = $values[$in{'sb1'}];
push (@hits, @values);
}
else {
(($numhits >= $first) and ($numhits <= $last)) and push (@hits, @values);
}
$numhits++; # But we always count it!
}
$numrecs++; #8/31/2008
}
close DBX;
# Now we've stored all our hits in @hits, and we've got a sorting values stored in %sortby indexed by their position in @hits.
$numhits ? ($db_total_hits = $numhits) : ($db_total_hits = 0); ($db_total_hits == 0) and return ("no matching records.$numrecs");
# Sort the array @hits in order if we are meant to sort.
if (exists $in{'sb1'}) {
# Sort hits on first field.
my ($sort_func, $tmp_func);
$sort_func = "";
$sort_pos = 1;
$sb_num = "sb" . "$sort_pos";
while (exists ($in{$sb_num})) {
$tmp_func = $sort_func eq "" ? "" : "$sort_func" . " || ";
$sort_func = $tmp_func . &build_sort_func2;
$sort_pos += 1;
$sb_num = "sb" . "$sort_pos";
}
$sort_func =~ tr/!/$/;
# Replace temporary characters with $
foreach $hit (sort { eval($sort_func); } (keys %sortby1)) {
$first = ($hit * $#db2_cols) + $hit;
$last = ($hit * $#db2_cols) + $#db2_cols + $hit;
push (@sortedhits, @hits[$first .. $last]);
}
@hits = @sortedhits;
}
#################
# If we have too many hits, let's build the next toolbar, and return only the hits we want.
if ($numhits > $maxhits) {
# Remove the nh= from the query string.
$next_url = $ENV{'QUERY_STRING'};
$next_url =~ s/\&nh=\d+//;
$next_hit = $nh + 1; $prev_hit = $nh - 1;
# Build the next hits toolbar. It seems really complicated as we have to do
# some number crunching to keep track of where we are on the toolbar, and so
# that the toolbar stays centred.
# First, set how many pages we have on the left and the right.
$left = $nh; $right = int($numhits/$maxhits) - $nh;
# Then work out what page number we can go above and below.
($left > 7) ? ($lower = $left - 7) : ($lower = 1);
($right > 7) ? ($upper = $nh + 7) : ($upper = int($numhits/$maxhits) + 1);
# Finally, adjust those page numbers if we are near an endpoint.
(7 - $nh >= 0) and ($upper = $upper + (8 - $nh));
($nh > ($numhits/$maxhits - 7)) and ($lower = $lower - ($nh - int($numhits/$maxhits - 7) - 1));
$db_next_hits = "";
# Then let's go through the pages and build the HTML.
($nh > 1) and ($db_next_hits .= qq~<a href="$db_script_url?$next_url&nh=$prev_hit">[<<]</a> ~);
for ($i = 1; $i <= int($numhits/$maxhits) + 1; $i++) {
if ($i < $lower) { $db_next_hits .= " ... "; $i = ($lower-1); next; }
if ($i > $upper) { $db_next_hits .= " ... "; last; }
($i == $nh) ?
($db_next_hits .= qq~$i ~) :
($db_next_hits .= qq~<a href="$db_script_url?$next_url&nh=$i">$i</a> ~);
if (($i * $maxhits) >= $numhits) { last; } # Special case if we hit exact.
}
$db_next_hits .= qq~<a href="$db_script_url?$next_url&nh=$next_hit">[>>]</a> ~ unless ($nh == $i);
$db_next_hits =~ s/&/&/g; #8/30/2008 for w3c validation
# Slice the @hits to only return the ones we want, only have to do this if the results are sorted.
if (exists $in{'sb1'}) {
$first = ($maxhits * ($nh - 1)) * ($#db2_cols+1);
$last = $first + (($#db2_cols+1) * $maxhits) - 1;
$last = $#hits if ($last > $#hits);
@hits = @hits[$first .. $last];
}
}
return ("ok", @hits);
}
sub array_to_hash2 {
# --------------------------------------------------------
# Converts an array to a hash using db_cols as the field names.
my($hit, @array) = @_;
my(%hash);
for ($j = 0; $j <= $#db2_cols; $j++) {
$hash{$db2_cols[$j]} = $array[$hit * ($#db2_cols+1) + $j];
}
return %hash;
}
sub join_encode2 {
# --------------------------------------------------------
# Takes a hash (ususally from the form input) and builds one
# line to output into the database. It changes all occurrences
# of the database delimeter to '~~' and all newline chars to '``'.
my (%hash) = @_;
my ($tmp, $col, $output);
foreach $col (@db2_cols) {
$tmp = $hash{$col};
$tmp =~ s/^\s+//g; # Trim leading blanks...
$tmp =~ s/\s+$//g; # Trim trailing blanks...
$tmp =~ s/\Q$db2_delim\E/~~/og; # Change delimeter to ~~ symbol.
$tmp =~ s/\n/``/g; # Change newline to `` symbol.
$tmp =~ s/\r//g; # Remove Windows linefeed character.
$output .= $tmp . $db2_delim; # Build Output.
}
chop $output; # remove extra delimeter.
$output .= "\n"; # add linefeed char.
return $output;
}