saint/discourse-legacysite-perl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

First pass at adding key files

Browse Source
This commit is contained in:
dsainty
2024-06-17 21:49:12 +10:00
commit aa25e9347f
1274 changed files with 392549 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

893
site/slowtwitch.com/cgi-bin/articles/GT/SQL/Display/HTML.pm Normal file
View File

@ -0,0 +1,893 @@
# ==================================================================
# Gossamer Threads Module Library - http://gossamer-threads.com/
#
# GT::SQL::Display::HTML
# Author: Scott & Alex
# $Id: HTML.pm,v 1.98 2009/03/23 22:55:53 brewt Exp $
#
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
# ==================================================================
#
# Description:
# HTML module that provides a set of method to control your
# user display in order to get rid of HTML coding inside CGI script.
#
package GT::SQL::Display::HTML;
# ===============================================================
use strict;
use vars qw/@ISA $AUTOLOAD $VERSION $ERROR_MESSAGE $ATTRIBS $DEBUG $FONT %SIZE_FORMS $INPUT_SEPARATOR/;
use GT::Base;
@ISA = qw/GT::Base/;
$FONT = 'face="Tahoma,Arial,Helvetica" size="2"';
$VERSION = sprintf "%d.%03d", q$Revision: 1.98 $ =~ /(\d+)\.(\d+)/;
$DEBUG = 0;
$ERROR_MESSAGE = 'GT::SQL';
$INPUT_SEPARATOR = "\n";
$ATTRIBS = {
db => undef,
input => undef,
mode => '',
code => {},
font => $FONT,
hide_timestamp => 0,
hide_download => 0,
file_field => 0,
file_delete => 0,
file_use_path => 0,
view_key => 0,
defaults => 0,
search_opts => 0,
values => {},
multiple => 0,
table => 'border="0" width="500"',
tr => '',
td => 'valign="top" align="left"',
extra_table => 1,
col_font => $FONT,
val_font => $FONT,
hide => [],
skip => [],
view => [],
disp_form => 1,
disp_html => 0,
url => $ENV{REQUEST_URI},
};
sub init {
# ---------------------------------------------------------------
# new() comes from GT::Base.
#
my $self = shift;
# Set any passed in options.
$self->set (@_);
# Try to set the URL
$self->{url} or eval { require GT::CGI; $self->{url} = GT::CGI->url(); };
$self->{url} ||= '';
# Make sure we have a database object.
# exists ($self->{db}) and (ref $self->{db}) or return $self->error ("BADARGS", "FATAL", "You must pass in a GT::SQL::Table object");
my $input = ref $self->{input};
if ($input and ($input eq 'GT::CGI')) {
$self->{input} = $self->{input}->get_hash;
}
elsif ($input and ($input eq 'CGI')) {
my $h = {};
foreach my $key ($self->{input}->param) {
$h->{$key} = $self->{input}->param($key);
}
$self->{input} = $h;
}
return $self;
}
sub reset_opts {
# ---------------------------------------------------------------
# Resets the display options.
#
my $self = shift;
while (my ($k, $v) = each %$ATTRIBS) {
next if $k eq 'db';
next if $k eq 'disp_form';
next if $k eq 'disp_html';
next if $k eq 'input';
if (! ref $v) {
$self->{$k} = $v;
}
elsif (ref $v eq 'HASH') {
$self->{$k} = {};
foreach my $k1 (keys %{$ATTRIBS->{$k}}) { $self->{$k}->{$k1} = $ATTRIBS->{$k}->{$k1}; }
}
elsif (ref $v eq 'ARRAY') {
$self->{$k} = [];
foreach my $v1 (@{$ATTRIBS->{$k}}) { push @{$self->{$k}}, $v1; }
}
else { $self->{$k} = $v; }
}
}
sub form {
# ---------------------------------------------------------------
# Display a record as an html form.
#
my $self = shift;
$_[0]->{disp_form} = 1;
$_[0]->{disp_html} = 0;
return $self->_display (@_);
}
sub display {
# ---------------------------------------------------------------
# Display a record as html.
#
my $self = shift;
$self->error ("NEEDSUBCLASS", "FATAL")
}
sub _get_defaults {
# -------------------------------------------------------------------
# Returns default values for fields. Bases it on what's passed in,
# cgi input, def file defaults, otherwise blank.
#
my $self = shift;
my @cols = $self->{db}->ordered_columns;
my $c = $self->{cols} || $self->{db}->cols;
my $values = {};
foreach my $col (@cols) {
my $value = '';
if (exists $self->{values}->{$col}) { $value = $self->{values}->{$col} }
elsif (exists $self->{input}->{$col}) { $value = $self->{input}->{$col} }
elsif ($self->{defaults} and exists $c->{$col}->{default}) {
if ($c->{$col}->{type} =~ /DATE|TIME|YEAR/) {
($c->{$col}->{default} =~ /0000/)
? ($value = $self->_get_time($c->{$col}))
: ($value = $c->{$col}->{default});
}
else {
$value = $c->{$col}->{default};
}
}
elsif ($self->{defaults} and $c->{$col}->{type} =~ /DATE|TIME|YEAR/) {
$value = $self->_get_time($c->{$col});
}
if ($c->{$col}->{form_type} and uc $c->{$col}->{form_type} eq 'FILE' ) {
for (qw/_filename _del/) {
$values->{$col.$_} = $self->{values}->{$col.$_} if exists $self->{values}->{$col.$_};
}
}
$values->{$col} = $value;
}
return $values;
}
sub _skip {
# -------------------------------------------------------------------
my ($self, $col) = @_;
# Skip timestamps, any fields requested to be skipped or any hidden fields (hidden forms appended at bottom).
return 1 if ($self->{hide_timestamp} and $self->{cols}->{$col}->{time_check});
return 1 if ($self->{skip} and (grep /^$col$/, @{$self->{skip}}));
return 1 if ($self->{hide} and (grep /^$col$/, @{$self->{hide}}));
return 0;
}
sub _get_form_display {
my ($self, $col) = @_;
if (
($self->{view_key} and
exists $self->{cols}->{$col}->{time_check} and
$self->{cols}->{$col}->{time_check})
||
($self->{view} and (grep /^$col$/, @{$self->{view}}))
)
{
return 'hidden_text';
}
my $form_type = lc $self->{cols}->{$col}->{form_type} or return 'default';
if ( $form_type eq 'password' and index( $self->{mode}, 'search_form' ) + 1 ) {
return 'default'
}
elsif ( $form_type and $self->can( $form_type ) ) {
return $form_type;
}
return 'default';
}
sub _get_html_display {
my $self = shift;
my $col = shift;
return 'display_text';
}
# Form types
sub default {
my ($self, $opts) = @_;
my $name = exists $opts->{name} ? $opts->{name} : return $self->error ("BADARGS", "FATAL", "No form name passed to form creator _mk_char_form");
my $def = exists $opts->{def} ? $opts->{def} : return $self->error ("BADARGS", "FATAL", "No type hash passed to form creator _mk_char_form");
my $val = exists $opts->{value} ? $opts->{value} : (exists $def->{default} ? $def->{default} : '');
my $size = exists $opts->{form_size} ? $opts->{form_size} : (exists $def->{form_size} ? ($def->{form_size} || 30) : 30);
my $max = exists $opts->{size} ? $opts->{def}->{size} : (exists $def->{size} ? $def->{size} : 255);
defined ($val) or $val = '';
_escape(\$val);
return qq~<input type="text" name="$name" value="$val" maxlength="$max" size="$size" />~;
}
sub date {
my ($self, $opts) = @_;
$opts->{form_size} ||= 20;
return $self->text ($opts);
}
sub multiple { shift->select (@_) }
sub select {
# ---------------------------------------------------------------
# Make a select list. Valid options are:
# name => FORM_NAME
# values => { form_value => displayed_value }
# value => selected_value
# or
# value => [selected_value1, selected_value2]
# multiple => n - adds MULTIPLE SIZE=n to select list
# sort => coderef called to sort the list or array ref specifying the order in
# which the fields should be display. A code ref, when called, will be
# passed the following arguments: ($value{$a}, $value{$b}, $a, $b)
# blank => 1 or 0. If true, a blank first option will be printed, if false
# the blank first element will not be printed. Defaults to true.
my ($self, $opts) = @_;
my $name = exists $opts->{name} ? $opts->{name} : return $self->error ("BADARGS1", "FATAL", "No form name passed to select");
my ($names, $values) = $self->_get_multi ($opts);
# Get the default value to display if nothing is selected.
my $def;
if (defined $opts->{value}) { $def = $opts->{value} }
else { $def = '' }
my %hash;
# Build key value pairs we can keep sorted
for (0 .. $#{$names}) {
$hash{$names->[$_]} = $values->[$_];
}
my ($sort_f, $sort_o);
if (ref $opts->{sort} eq 'CODE') {
$sort_f = $opts->{sort};
}
elsif (ref $opts->{sort} eq 'ARRAY') {
$sort_o = $opts->{sort};
}
# sort_order => [...] has been replaced with sort => [...] and so it
# is NOT mentioned in the subroutine comments.
elsif (ref $opts->{sort_order} eq 'ARRAY') {
$sort_o = $opts->{sort_order};
}
my $blank = exists $opts->{blank} ? $opts->{blank} : 1;
# Multiple was passed in
my $mult;
my $clean_name = $name;
if ($name =~ /^\d\-(.+)$/) {
$clean_name = $1;
}
if (exists $self->{cols}->{$clean_name} and $self->{cols}->{$clean_name}->{form_type} and $self->{cols}->{$clean_name}->{form_type} eq 'MULTIPLE') {
$mult = qq! multiple="multiple" size="$self->{cols}->{$clean_name}->{form_size}"!;
}
elsif (exists $opts->{multiple} and $opts->{multiple} > 1) {
$mult = qq! multiple="multiple" size="$opts->{multiple}"!;
}
elsif (exists $self->{cols}->{$clean_name} and $self->{cols}->{$clean_name}->{form_size}) {
$mult = qq! size="$self->{cols}->{$clean_name}->{form_size}"!;
}
else {
$mult = '';
}
my $class = ($opts->{def}->{class}) ? qq| class="$opts->{def}->{class}"| : "";
my $out = qq~<select$mult name="$name"$class>~;
$blank and ($out .= qq~<option value="">---</option>~);
# Figure out how to order this select list.
my @keys;
if ($sort_o) { @keys = @$sort_o }
elsif ($sort_f) { @keys = sort { $sort_f->($hash{$a}, $hash{$b}, $a, $b) } keys %hash }
else { @keys = @$names; }
if (! ref $def) {
$def = { map { ($_ => 1) } split (/\Q$INPUT_SEPARATOR\E%?/o, $def) };
}
else { # Array ref
$def = { map { ($_ => 1) } @$def };
}
for my $key (@keys) {
my $val = $hash{$key};
_escape(\$val);
$out .= qq~<option value="$key"~;
$out .= ' selected="selected"' if $def->{$key};
$out .= ">$val</option>";
}
$out .= "</select>\n";
return $out;
}
sub radio {
# ---------------------------------------------------------------
# Create a radio series.
#
my ($self, $opts) = @_;
my $name = exists $opts->{name} ? $opts->{name} : return $self->error ("BADARGS", "FATAL", "No name for field passed to radio");
my ($names, $values) = $self->_get_multi ($opts);
# Make sure we have something.
if (! @{$names} or ! @{$values}) {
return $self->error ("BADARGS", "FATAL", "No value hash passed to checkbox");
}
my $def;
if (defined $opts->{value}) { $def = $opts->{value} }
elsif (exists $opts->{def}->{default}) { $def = $opts->{def}->{default} }
else { $def = '' }
my %hash;
# Build key value pairs we can keep sorted
for (0 .. $#{$names}) {
$hash{$names->[$_]} = $values->[$_];
}
my $sort_f = exists $opts->{sort} ? $opts->{sort} : sub { lc $hash{$a} cmp lc $hash{$b} };
my $sort_o = exists $opts->{sort_order} ? $opts->{sort_order} : '';
my $out;
# Figure out how to order this select list.
my @keys;
if ($sort_o) { @keys = @$sort_o; }
elsif ($sort_f) { @keys = sort { $sort_f->() } keys %hash; }
else { @keys = keys %hash; }
(ref $def eq 'ARRAY') or ($def = [$def]);
my $class = ($opts->{def}->{class}) ? qq| class="$opts->{def}->{class}"| : "";
KEY: foreach my $key (@keys) {
my $val = $hash{$key};
_escape(\$val);
VAL: foreach my $sel (@$def) {
($key eq $sel) and ($out .= qq~$val<input type="radio" value="$key"$class name="$name" checked="checked" /> ~) and next KEY;
}
$out .= qq~$val<input name="$name" type="radio" value="$key"$class /> ~;
}
return $out;
}
sub checkbox {
# ---------------------------------------------------------------
# Create a checkbox set.
#
my ($self, $opts) = @_;
my $name = exists $opts->{name} ? $opts->{name} : return $self->error ("BADARGS", "FATAL", "No form name passed to select");
my ($names, $values) = $self->_get_multi ($opts);
# Make sure we have something.
if (! @{$names} or ! @{$values}) {
return $self->error ("BADARGS", "FATAL", "No value hash passed to checkbox");
}
my %hash;
# Build key value pairs we can keep sorted
for (0 .. $#{$names}) {
$hash{$names->[$_]} = $values->[$_];
}
my $def;
if (defined $opts->{value}) { $def = $opts->{value} }
elsif (exists $opts->{def}->{default}) { $def = $opts->{def}->{default} }
else { $def = '' }
my $sort_f = exists $opts->{sort} ? $opts->{sort} : sub { lc $hash{$a} cmp lc $hash{$b} };
my $sort_o = exists $opts->{sort_order} ? $opts->{sort_order} : '';
my $out;
# Figure out how to order this select list.
my @keys;
if ($sort_o) { @keys = @$sort_o; }
elsif ($sort_f) { @keys = sort { $sort_f->() } keys %hash }
else { @keys = keys %hash }
if (! ref $def) {
$def = [sort split (/\Q$INPUT_SEPARATOR\E%?/o, $def)];
}
my $class = ($opts->{def}->{class}) ? qq| class="$opts->{def}->{class}"| : "";
KEY: foreach my $key (@keys) {
my $val = $hash{$key};
_escape(\$val);
VAL: foreach my $sel (@$def) {
($key eq $sel) and ($out .= qq~ <input name="$name" type="checkbox" value="$key" checked="checked"$class />$val~) and next KEY;
}
$out .= qq~ <input name="$name" type="checkbox" value="$key"$class />$val~;
}
return $out;
}
sub hidden {
# ---------------------------------------------------------------
# Create a hidden field.
#
my ($self, $opts) = @_;
my $name = exists $opts->{name} ? $opts->{name} : return $self->error ("BADARGS", "FATAL", "No form name passed to select");
my $def;
if (defined $opts->{value}) { $def = $opts->{value} }
elsif (exists $opts->{def}->{default}) { $def = $opts->{def}->{default} }
else { $def = '' }
_escape(\$def);
return qq~<input type="hidden" name="$name" value="$def" />~;
}
sub hidden_text {
my ($self, $opts) = @_;
my $out;
my $html = $self->_get_html_display;
$out .= "<font $self->{val_font}>";
$out .= $self->$html($opts);
my $def;
if (defined $opts->{value}) { $def = $opts->{value} }
elsif (exists $opts->{def}->{default}) { $def = $opts->{def}->{default} }
elsif (exists $opts->{def}->{time_check}) { $def = $self->_get_time ($opts->{def}) }
else { $def = '' }
_escape(\$def);
$out .= qq~<input type="hidden" name="$opts->{name}" value="$def" /></font>~;
return $out;
}
sub file {
# ---------------------------------------------------------------
# creates a file field
#
# function is a bit large since it has to do a fair bit, with multiple options.
#
my ($self, $opts, $values, $display ) = @_;
$values ||= {};
$self->{file_field} or return $self->text($opts);
my @parts = split /\./, $opts->{name};
my $name = pop @parts;
my $dbname = shift @parts || $self->{db}->name;
my $prefix = $self->{db}->prefix;
$dbname =~ s,^$prefix,, if ($prefix);
my $def = $opts->{def};
my $out;
my $colname = $opts->{name}; $colname =~ s,^\d*-,,;
my $fname = $opts->{value};
_escape(\$fname);
# Find out if the file exists
my $tbl = $display->{db}->new_table( $dbname . "_Files" ) or return 'Associated _File table is missing';
my @pk = $self->{db}->pk; @pk == 1 or return 'File handling requires one primary key';
my $href = $tbl->get({ ForeignColName => $colname, ForeignColKey => $values->{$pk[0]} });
my $use_path = $self->{file_use_path} && -e $opts->{value};
if ($use_path or $href) {
require GT::SQL::File;
my $sfname = $values->{$colname."_filename"};
$out = $sfname || GT::SQL::File->get_filename($fname ||= $href->{File_Name});
$use_path and $out .= qq!<input name="$opts->{name}_path" type="hidden" value="$fname" />!;
$sfname and $out .= qq!<input type="hidden" name="$opts->{name}_filename" value="$sfname" />!;
if ( $fname and $self->{file_delete} ) {
if ( $def->{form_type} =~ /^file$/i and not $self->{hide_downloads} and $self->{url} ) {
my $url = _reparam_url(
$self->{url},
{
do => 'download_file',
id => $values->{$pk[0]},
cn => $colname,
db => $dbname,
src => $use_path ? 'path' : 'db',
fname => $fname
},
[qw( do id cn db src )]
);
$out .= qq! <font $self->{font}><font size="1"><i><a href="$url">download</a></i></font></font>!;
$url = _reparam_url(
$self->{url},
{
do => 'view_file',
id => $values->{$pk[0]},
cn => $colname,
db => $dbname,
src => $use_path ? 'path' : 'db',
fname => $fname
},
[qw( do id cn db src )]
);
$out .= qq! <font $self->{font}><font size="1"><i><a href="$url" target="_blank">view</a></i></font></font>!;
}
my $checked = $values->{"${colname}_del"} ? ' checked="checked" ' : '';
$out .= qq~ <input type="checkbox" name="$opts->{name}_del" value="delete"$checked /> Delete~;
}
}
my $class = ($opts->{def}->{class}) ? qq| class="$opts->{def}->{class}"| : "";
$out .= qq~<input type="file" name="$opts->{name}"$class />~;
return $out;
}
sub text {
# ---------------------------------------------------------------
# Create a text field.
#
my ($self, $opts) = @_;
my $name = exists $opts->{name} ? $opts->{name} : return $self->error ("BADARGS", "FATAL", "No form name passed to select");
my $size = $opts->{def}->{form_size} ? $opts->{def}->{form_size} : $SIZE_FORMS{uc $opts->{def}->{type}};
$size ||= 20;
my $def;
if (defined $opts->{value}) { $def = $opts->{value} }
elsif (exists $opts->{def}->{default}) { $def = $opts->{def}->{default} }
else { $def = '' }
_escape(\$def);
my $class = ($opts->{def}->{class}) ? qq| class="$opts->{def}->{class}"| : "";
return qq~<input type="text" name="$name" value="$def" size="$size"$class />~;
}
sub password {
# ---------------------------------------------------------------
# Create a password field.
#
my ($self, $opts) = @_;
my $name = exists $opts->{name} ? $opts->{name} : return $self->error ("BADARGS", "FATAL", "No form name passed to select");
my $size = $opts->{def}->{form_size} ? $opts->{def}->{form_size} : $SIZE_FORMS{uc $opts->{def}->{type}};
$size ||= 20;
my $def;
if ( $opts->{blank} ) { $def = '' } # keep the password element blank
elsif (defined $opts->{value}) { $def = $opts->{value} }
elsif (exists $opts->{def}->{default}) { $def = $opts->{def}->{default} }
else { $def = '' }
_escape(\$def);
my $class = ($opts->{def}->{class}) ? qq| class="$opts->{def}->{class}"| : "";
return qq~<input type="password" name="$name" value="$def" size="$size"$class />~;
}
sub textarea {
# ---------------------------------------------------------------
# Create a textarea.
#
my ($self, $opts) = @_;
my $name = exists $opts->{name} ? $opts->{name} : return $self->error ("BADARGS", "FATAL", "No form name passed to select");
my $size = $opts->{def}->{form_size} ? $opts->{def}->{form_size} : $SIZE_FORMS{uc $opts->{def}->{type}};
$size ||= 20;
my ($cols, $rows) = (ref $size) ? (@{$size}) : ($size, 4);
my $def;
if (defined $opts->{value}) { $def = $opts->{value} }
elsif (exists $opts->{def}->{default}) { $def = $opts->{def}->{default} }
else { $def = '' }
_escape(\$def);
my $class = ($opts->{def}->{class}) ? qq| class="$opts->{def}->{class}"| : "";
return qq~<textarea rows="$rows" cols="$cols" name="$name"$class>\n$def</textarea>~;
}
sub display_text {
# ---------------------------------------------------------------
my $self = shift;
my $opts = shift or return $self->error ("BADARGS", "FATAL", "No hash ref passed to form creator display_text");
my $values = shift;
my $def = exists $opts->{def} ? $opts->{def} : return $self->error ("BADARGS", "FATAL", "No type hash passed to view creator display_text (" . (caller())[2] . ")" );
my $val = exists $opts->{value} ? $opts->{value} : (exists $def->{default} ? $def->{default} : '');
my $pval = $val;
defined $val or ($val = '');
_escape(\$val);
# If they are using checkbox/radio/selects then we map form_names => form_values.
if (ref $def->{form_names} and ref $def->{form_values}) {
if (@{$def->{form_names}} and @{$def->{form_values}}) {
my %map = map { $def->{form_names}->[$_] => $def->{form_values}->[$_] } (0 .. $#{$def->{form_names}});
my @keys = split /\Q$INPUT_SEPARATOR\E|\n/, $val;
$val = '';
foreach (@keys) {
$val .= $map{$_} ? $map{$_} : $_;
$val .= "<br />";
}
}
}
if ($def->{form_type} and uc $def->{form_type} eq 'FILE' and not $self->{hide_downloads} and $self->{url}) {
$pval or return $val;
my @parts = split /\./, $opts->{name};
my $name = pop @parts;
my $dbname = shift @parts || $self->{db}->name;
my $prefix = $self->{db}->prefix;
$dbname =~ s,^$prefix,, if ($prefix);
my $colname = $opts->{name}; $colname =~ s,^$dbname\.,,g;
my @pk = $self->{db}->pk; @pk == 1 or return;
my $url = _reparam_url( $self->{url}, { do => 'download_file', id => $values->{$pk[0]}, cn => $colname, db => $dbname }, [qw( do id cn db )] );
$val .= qq! <font $self->{font}><font size="1"><i><a href="$url">download</a></i></font></font>!;
$url = _reparam_url( $self->{url}, { do => 'view_file', id => $values->{$pk[0]}, cn => $colname, db => $dbname }, [qw( do id cn db )] );
$val .= qq! <font $self->{font}><font size="1"><i><a href="$url" target="_blank">view</a></i></font></font>!;
}
return $val;
}
sub _reparam_url {
# ---------------------------------------------------------------
my $orig_url = shift;
my $add = shift || {};
my $remove = shift || [];
my %params = ();
my $new_url = $orig_url;
# get the original parameters
my $qloc = index( $orig_url, '?');
if ( $qloc > 0 ) {
require GT::CGI;
$new_url = substr( $orig_url, 0, $qloc );
my $base_parms = substr( $orig_url, $qloc+1 );
$base_parms = GT::CGI::unescape($base_parms);
# now parse the parameters
foreach my $param ( grep $_, split /[&;]/, $base_parms ) {
my $eloc = index( $param, '=' );
$eloc < 0 and push( @{$params{$param} ||= []}, undef ), next;
my $key = substr( $param, 0, $eloc );
my $value = substr( $param, $eloc+1 );
push( @{$params{$key} ||= []}, $value);
}
}
# delete a few parameters
foreach my $param ( @$remove ) { delete $params{$param}; }
# add a few parameters
foreach my $key ( keys %$add ) {
push( @{$params{$key} ||= []}, $add->{$key});
}
# put everything together
require GT::CGI;
my @params;
foreach my $key ( keys %params ) {
foreach my $value ( @{$params{$key}} ) {
push @params, GT::CGI::escape($key).'='.GT::CGI::escape($value);
}
}
$new_url .= "?" . join( '&', @params );
return $new_url;
}
sub toolbar {
# ---------------------------------------------------------------
# Display/calculate a "next hits" toolbar.
#
my $class = shift;
my ($nh, $maxhits, $numhits, $script) = @_;
my ($next_url, $max_page, $next_hit, $prev_hit, $left, $right, $upper, $lower, $first, $url, $last, $i);
# Return if there shouldn't be a speedbar.
return unless ($numhits > $maxhits);
# Strip nh=\d out of the query string, as we need to append it on. Try and keep
# the url looking nice (i.e. no double ;&, or extra ?.
$script =~ s/[&;]nh=\d+([&;]?)/$1/;
$script =~ s/\?nh=\d+[&;]?/\?/;
($script =~ /\?/) or ($script .= "?");
$script =~ s/&/&amp;/g;
$next_hit = $nh + 1;
$prev_hit = $nh - 1;
$maxhits ||= 25;
$max_page = int ($numhits / $maxhits) + (($numhits % $maxhits) ? 1 : 0);
# 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));
$url = "";
# Then let's go through the pages and build the HTML.
($nh > 1) and ($url .= qq~<a href="$script;nh=1">[&lt;&lt;]</a> ~);
($nh > 1) and ($url .= qq~<a href="$script;nh=$prev_hit">[&lt;]</a> ~);
for ($i = 1; $i <= int($numhits/$maxhits) + 1; $i++) {
if ($i < $lower) { $url .= " ... "; $i = ($lower-1); next; }
if ($i > $upper) { $url .= " ... "; last; }
($i == $nh) ?
($url .= qq~$i ~) :
($url .= qq~<a href="$script&amp;nh=$i">$i</a> ~);
if ($i * $maxhits == $numhits) { $nh == $i and $next_hit = $i; last; }
}
$url .= qq~<a href="$script;nh=$next_hit">[&gt;]</a> ~ unless ($next_hit == $nh or ($nh * $maxhits > $numhits));
$url .= qq~<a href="$script;nh=$max_page">[&gt;&gt;]</a> ~ unless ($next_hit == $nh or ($nh * $maxhits > $numhits));
return $url;
}
sub escape {
# ---------------------------------------------------------------
# Public wrapper to private method.
#
return _escape ($_[1]);
}
# ================================================================================ #
# SEARCH WIDGETS #
# ================================================================================ #
sub _mk_search_opts {
# ---------------------------------------------------------------
# Create the search options boxes based on type.
#
my $self = shift;
my $opts = shift or return $self->error ("BADARGS", "FATAL", "No hash ref passed to form creator _mk_search_opts");
my $name = exists $opts->{name} ? $opts->{name} : return $self->error ("BADARGS", "FATAL", "No form name passed to form creator _mk_search_opts");
my $def = exists $opts->{def} ? $opts->{def} : return $self->error ("BADARGS", "FATAL", "No type hash passed to form creator _mk_search_opts");
my $val = '';
CASE: {
exists $opts->{value} and $val = $opts->{value}, last CASE;
exists $self->{input}->{"$name-opt"} and $val = $self->{input}->{"$name-opt"}, last CASE;
$opts->{pk} and $val = '=', last CASE;
$opts->{unique} and $val = '=', last CASE;
}
$val = '&gt;' if $val eq '>';
$val = '&lt;' if $val eq '<';
my $type = $def->{type};
my ($hash, $so);
CASE: {
($type =~ /INT|FLOAT|DOUBLE|DECIMAL/i)
and $hash = { 'LIKE' => 'Like', '=' => 'Exact Match', '<>' => 'Not Equal', '&gt;' => 'Greater Than', '&lt;' => 'Less Than' },
$so = [ 'LIKE', '=', '<>', '&gt;', '&lt;' ],
$val ||= '=', last CASE;
($type =~ /CHAR/i)
and $hash = { 'LIKE' => 'Like', '=' => 'Exact Match', '<>' => 'Not Equal', },
$so = [ 'LIKE', '=', '<>' ], last CASE;
($type =~ /DATE|TIME/i)
and $hash = { '=' => 'Exact Match', '<>' => 'Not Equal', '&gt;' => 'Greater Than', '&lt;' => 'Less Than' },
$so = [ '=', '&gt;', '&lt;', '<>' ], last CASE;
}
if ($hash) {
return $self->select( { name => "$name-opt", values => $hash, sort_order => $so, value => $val, def => $def, blank => 0 } );
}
else {
return undef;
}
}
# ================================================================================ #
# UTILS #
# ================================================================================ #
sub _escape {
# ---------------------------------------------------------------
# Escape HTML quotes and < and >.
#
my $t = shift;
return unless $$t;
$$t =~ s/&/&amp;/g;
$$t =~ s/"/&quot;/g;
$$t =~ s/</&lt;/g;
$$t =~ s/>/&gt;/g;
}
sub _get_time {
# ---------------------------------------------------------------
# Return current time for timestamp field.
#
my ($self, $col) = @_;
my ($sec,$min,$hr,$day,$mon,$yr) = (localtime())[0..5];
my $val;
$mon++; $yr = $yr + 1900;
($sec < 10) and ($sec = "0$sec"); ($min < 10) and ($min = "0$min"); ($hr < 10) and ($hr = "0$hr");
($day < 10) and ($day = "0$day"); ($mon < 10) and ($mon = "0$mon");
CASE: {
($col->{type} =~ /DATETIME|TIMESTAMP/) and ($val = "$yr-$mon-$day $hr:$min:$sec"), last CASE;
($col->{type} =~ /DATE/) and ($val = "$yr-$mon-$day"), last CASE;
($col->{type} =~ /YEAR/) and ($val = "$yr"), last CASE;
}
return $val;
}
sub _get_multi {
my ($self, $opts) = @_;
my ($names, $values) = ([], []);
$opts->{def} ||= $self->{db}->{schema}->{cols}->{$opts->{name}};
# Deep copy $opts->{def} => $def
my $def = {};
while (my ($k, $v) = each %{$opts->{def}}) {
if (! ref $v) {
$def->{$k} = $v;
}
elsif (ref $v eq 'HASH') {
$def->{$k} = {};
foreach my $k1 (keys %{$opts->{def}->{$k}}) { $def->{$k}->{$k1} = $opts->{def}->{$k}->{$k1}; }
}
elsif (ref $v eq 'ARRAY') {
$def->{$k} = [];
foreach my $v1 (@{$opts->{def}->{$k}}) { push @{$def->{$k}}, $v1; }
}
else { $def->{$k} = $v; }
}
if (
(exists $def->{form_names}) and
(ref ($def->{form_names}) eq 'ARRAY') and
(@{$def->{form_names}})
)
{
$names = $def->{form_names};
}
elsif (
(exists $def->{values}) and
(ref ($def->{values}) eq 'ARRAY') and
(@{$def->{values}})
)
{
$names = $def->{values};
}
# Get the values.
if (
(exists $def->{form_values}) and
(ref ($def->{form_values}) eq 'ARRAY') and
(@{$def->{form_values}})
)
{
$values = $def->{form_values};
}
elsif (
(exists $def->{values}) and
(ref ($def->{values}) eq 'ARRAY') and
(@{$def->{values}})
)
{
$values = $def->{values};
}
# Can pass in a hash here.
if (
(exists $opts->{values}) and
(ref ($opts->{values}) eq 'HASH') and
(keys %{$opts->{values}})
)
{
@{$names} = keys %{$opts->{values}};
@{$values} = values %{$opts->{values}};
}
@{$names} or @{$names} = @{$values};
@{$values} or @{$values} = @{$names};
return ($names, $values);
}
1;
# Options for display forms/views:
# hide_timestamp => 1 # Do not display timestamp fields
# search_opts => 1 # Add search options boxes.
# multiple => 1 # Prepend $multiple- to column names.
# defaults => 1 # Use .def defaults.
# values => {} # hash ref of values to use (overrides input)
# table => 'string' # table properties, defaults to 0 border.
# tr => 'string' # table row properties, defaults to none.
# td => 'string' # table cell properties, defaults to just aligns.
# extra_table => 0 # disable wrap form in extra table for looks.
# col_font => 'string' # font to use for columns, defaults to $FONT.
# val_font => 'string' # font to use for values, defaults to $FONT.
# hide => [] # display fields as hidden tags.
# view => [] # display fields as html with hidden tags as well.
# skip => [] # don't display array of column names.

278
site/slowtwitch.com/cgi-bin/articles/GT/SQL/Display/HTML/Relation.pm Normal file
View File

@ -0,0 +1,278 @@
# ==================================================================
# Gossamer Threads Module Library - http://gossamer-threads.com/
#
# GT::SQL::Display::HTML
# Author: Scott & Alex
# $Id: Relation.pm,v 1.18 2004/08/28 03:53:45 jagerman Exp $
#
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
# ==================================================================
#
# Description:
# HTML module that provides a set of method to control your
# user display in order to get rid of HTML coding inside CGI script.
#
package GT::SQL::Display::HTML::Relation;
# ===============================================================
use strict;
use vars qw/@ISA $AUTOLOAD $VERSION $ERROR_MESSAGE $ATTRIBS $DEBUG $FONT %SIZE_FORMS/;
use GT::SQL::Display::HTML;
@ISA = qw/GT::SQL::Display::HTML/;
$FONT = 'face="Tahoma,Arial,Helvetica" size=2';
$VERSION = sprintf "%d.%03d", q$Revision: 1.18 $ =~ /(\d+)\.(\d+)/;
$DEBUG = 0;
$ERROR_MESSAGE = 'GT::SQL';
$ATTRIBS = {
db => undef,
input => undef,
code => {},
mode => '',
font => $FONT,
hide_timestamp => 0,
view_key => 0,
defaults => 0,
search_opts => 0,
values => {},
multiple => 0,
table => 'border=0 width=500',
tr => '',
td => 'valign=top align=left',
extra_table => 1,
col_font => $FONT,
val_font => $FONT,
hide => [],
skip => [],
view => [],
disp_form => 1,
disp_html => 0,
file_field => 0,
file_delete => 0,
file_use_path => 0,
};
sub display {
# ---------------------------------------------------------------
# Display a record as html.
#
my $self = shift;
my $opts = shift;
$self->reset_opts;
$opts->{disp_form} = 0;
$opts->{disp_html} = 1;
return $self->_display ($opts || ());
}
sub _display {
# ---------------------------------------------------------------
# Handles displaying of a form or a record.
#
my $self = shift;
# Initiate if we are passed in any arguments as options.
if (@_) { $self->init (@_); }
# Get the column hash and primary key
$self->{pk} = [$self->{db}->pk] unless $self->{pk};
$self->{cols} = $self->{db}->ordered_columns;
# Output
my $out = '';
# Hide the primary keys.
$self->{view_key} and push (@{$self->{view}}, @{$self->{pk}}) if ($self->{pk});
# Now go through each column and print out a column row.
my @ntables = values %{$self->{db}->{tables}};
my (@tmp, @tables);
for my $t (@ntables) {
my @cols = $t->ordered_columns;
my %fk = $t->fk;
my %cols = $t->cols;
my $name = $t->name;
my $found = 0;
COL: foreach my $col_name (@cols) {
if (exists $self->{values}->{$col_name}) {
$self->{values}->{$name . '.' . $col_name} = delete $self->{values}->{$col_name};
}
$self->{cols}->{$name . '.' . $col_name} = $cols{$col_name};
FK: for (keys %fk) {
if (exists $self->{db}->{tables}->{$_}) {
if (exists $fk{$_}->{$col_name}) {
$found = 1;
last FK;
}
}
}
}
$found ? (push (@tmp, $t)) : (@tables = ($t));
}
push @tables, @tmp;
# Calculate the form values.
my $values = $self->_get_defaults;
# Set the table widths depending on if we need a third column.
my ($cwidth, $vwidth) = ('30%', '70%');
if ($self->{search_opts}) { $cwidth = "30%"; $vwidth = "60%" }
for my $table (@tables) {
$out .= $self->mk_table (
table => $table,
values => $values,
cwidth => $cwidth,
vwidth => $vwidth
);
}
$out .= '<br>';
foreach (@{$self->{hide}}) {
my $field_name = $self->{multiple} ? "$self->{multiple}-$_" : $_;
my $val = $values->{$_};
if (exists $self->{cols}->{$_}->{time_check} and $self->{cols}->{$_}->{time_check}) {
$val ||= $self->_get_time ($self->{cols}->{$_});
}
defined $val or ($val = '');
GT::SQL::Display::HTML::_escape(\$val);
$out .= qq~<input type="hidden" name="$field_name" value="$val">~;
}
$self->{extra_table} and ($out .= "</td></tr></table>\n");
return $out;
}
sub mk_table {
my $self = shift;
my %opt = @_;
my $out = '';
$self->{extra_table} and ($out .= "<p><table border=1 cellpadding=0 cellspacing=0><tr><td>");
my $cols = $opt{table}->cols;
my $name = $opt{table}->name;
$out .= qq(
<table $self->{table}>
<tr><td colspan=3 bgcolor=navy>
<FONT FACE="MS Sans Serif, arial,helvetica" size=1 COLOR="#FFFFFF">$name</font>
</td></tr>
);
my @cols = $opt{table}->ordered_columns;
my %fk = $opt{table}->fk;
COL: foreach my $col_name (@cols) {
$out .= $self->mk_row (%opt, col_name => $col_name, fk => \%fk);
}
$out .= "</table>\n";
$out .= "</table></p>\n" if $self->{extra_table};
return $out;
}
sub mk_row {
my $self = shift;
my %opt = @_;
my $out = '';
for (keys %{$opt{fk}}) {
if (exists $self->{db}->{tables}->{$_}) {
(exists $opt{fk}->{$_}->{$opt{col_name}}) and return '';
}
}
my $col = $opt{table}->name . '.' . $opt{col_name};
# Run any code refs that have been setup.
if (exists $self->{code}->{$col} and (ref $self->{code}->{$col} eq 'CODE')) {
$out .= $self->{code}->{$col}->($self, $self->{cols}->{$col}, $opt{values});
return '';
}
return '' if $self->_skip ($col);
# Set the form name (using increment for multiple if requested) and also the display name.
my $field_name = $self->{multiple} ? "$self->{multiple}-$col" : $col;
my $display_name = exists ($self->{cols}->{$col}->{form_display}) ? $self->{cols}->{$col}->{form_display} : $col;
my $value = $opt{values}->{$col};
my $disp = $self->{disp_form} ? $self->_get_form_display ($col) : $self->_get_html_display ($col);
$disp eq 'hidden' and push (@{$self->{hide}}, $col) and return '';
$out .= "<tr $self->{tr}><td $self->{td} width='$opt{cwidth}'><font $self->{col_font}>$display_name</font></td><td $self->{td} width='$opt{vwidth}'><font $self->{val_font}>";
# Get the column display subroutine
$out .= $self->$disp( { name => $field_name, def => $self->{cols}->{$col}, value => $value }, $opt{values}, $self );
$out .= "</font></td>";
# Display any search options if requested.
if ($self->{search_opts}) {
my $is_pk = 0;
for (@{$self->{pk}}) {
$is_pk = 1, last if ($_ eq $col);
}
$out .= qq~<td $self->{td} width="10%"><font $self->{val_font}>~;
$out .= $self->_mk_search_opts({
name => $field_name,
def => $self->{cols}->{$col},
pk => $is_pk
}) || '&nbsp;';
$out .= "</font></td>";
}
$out .= "\n";
return $out;
}
sub _get_defaults {
# -------------------------------------------------------------------
# Returns default values for fields. Bases it on what's passed in,
# cgi input, def file defaults, otherwise blank.
#
my $self = shift;
my @ntables = values %{$self->{db}->{tables}};
my @cols = $self->{db}->ordered_columns;
my $c = $self->{cols};
my $values = {};
foreach my $col (@cols) {
my $value = '';
if (exists $self->{values}->{$col}) { $value = $self->{values}->{$col} }
elsif (exists $self->{input}->{$col}) { $value = $self->{input}->{$col} }
elsif ($self->{defaults} and exists $c->{$col}->{default}) {
if ($c->{$col}->{type} =~ /DATE|TIME|YEAR/) {
(defined $c->{$col}->{default} and $c->{$col}->{default} =~ /0000/)
? ($value = $self->_get_time($c->{$col}))
: ($value = $c->{$col}->{default});
}
else {
$value = $c->{$col}->{default};
}
}
elsif ($self->{defaults} and $c->{$col}->{type} =~ /DATE|TIME|YEAR/) {
$value = $self->_get_time($c->{$col});
}
$values->{$col} = $value;
}
return $values;
}
1;
__END__
=pod
# Options for display forms/views:
# hide_timestamp => 1 # Do not display timestamp fields.
# search_opts => 1 # Add search options boxes.
# multiple => 1 # Prepend $multiple- to column names.
# defaults => 1 # Use .def defaults.
# values => {} # hash ref of values to use (overrides input)
# table => 'string' # table properties, defaults to 0 border.
# tr => 'string' # table row properties, defaults to none.
# td => 'string' # table cell properties, defaults to just aligns.
# extra_table => 0 # disable wrap form in extra table for looks.
# col_font => 'string' # font to use for columns, defaults to $FONT.
# val_font => 'string' # font to use for values, defaults to $FONT.
# hide => [] # display fields as hidden tags.
# view => [] # display fields as html with hidden tags as well.
# skip => [] # don't display array of column names.
=cut

299
site/slowtwitch.com/cgi-bin/articles/GT/SQL/Display/HTML/Table.pm Normal file
View File

@ -0,0 +1,299 @@
# ==================================================================
# Gossamer Threads Module Library - http://gossamer-threads.com/
#
# GT::SQL::Display::HTML
# Author: Scott & Alex
# $Id: Table.pm,v 1.29 2009/05/11 23:09:59 brewt Exp $
#
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
# ==================================================================
#
# Description:
# HTML module that provides a set of method to control your
# user display in order to get rid of HTML coding inside CGI script.
#
package GT::SQL::Display::HTML::Table;
# ===============================================================
use strict;
use vars qw/@ISA $AUTOLOAD $VERSION $ERROR_MESSAGE $ATTRIBS $DEBUG $FONT %SIZE_FORMS/;
use GT::SQL::Display::HTML;
@ISA = qw/GT::SQL::Display::HTML/;
$FONT = 'face="Tahoma,Arial,Helvetica" size=2';
$VERSION = sprintf "%d.%03d", q$Revision: 1.29 $ =~ /(\d+)\.(\d+)/;
$DEBUG = 0;
$ERROR_MESSAGE = 'GT::SQL';
$ATTRIBS = {
db => undef,
input => undef,
code => {},
font => $FONT,
hide_timestamp => 0,
view_key => 0,
defaults => 0,
search_opts => 0,
values => {},
multiple => 0,
table => 'border=0 width=500',
tr => '',
mode => '',
td => 'valign=top align=left',
extra_table => 1,
col_font => $FONT,
val_font => $FONT,
hide => [],
skip => [],
view => [],
disp_form => 1,
disp_html => 0,
file_field => 0,
file_delete => 0,
file_use_path => 0
};
sub display_row {
# ---------------------------------------------------------------
# Display a record row as html.
#
my ($self, $opts) = @_;
$opts->{disp_form} = 0;
$opts->{disp_html} = 1;
return $self->_display_row ($opts || ());
}
sub display_row_cols {
# ---------------------------------------------------------------
# returns the <td></td> for each of the title names for columns
#
my $self = shift;
# Initiate if we are passed in any arguments as options.
if (@_) { $self->init (@_); }
# Get the column hash and primary key
$self->{cols} = $self->{db}->cols unless exists $self->{cols};
$self->{pk} = [$self->{db}->pk] unless exists $self->{pk};
# Output
my $out = '';
# Hide the primary keys.
$self->{view_key} and push (@{$self->{view}}, @{$self->{pk}});
# Calculate the form values.
my $values = $self->_get_defaults;
# Now go through each column and print out a column row.
my @cols = $self->{db}->ordered_columns;
my $script = GT::CGI->url();
$script =~ s/[\&;]?sb=([^&;]*)//g;
my $sb = $1;
$script =~ s/[\&;]?so=(ASC|DESC)//g;
my $so = $1;
foreach my $col (@cols) {
$out .= qq!\n\t<td><font $self->{col_font}><b>!;
$out .= qq!<a href="$script&sb=$col&so=! . ( ( ( $col eq $sb ) and $so eq 'ASC' ) ? 'DESC' : 'ASC' ) . qq!">!;
$out .= exists $self->{db}->{schema}->{cols}->{$col}->{form_display} ? $self->{db}->{schema}->{cols}->{$col}->{form_display} : $col;
$out .= ( ( $col eq $sb ) ? ( ($so eq 'ASC') ? " ^" : " v" ) : '' ) . "</a>";
$out .= qq!</b></font></td>\n!;
}
return $out;
}
sub _display_row {
# ---------------------------------------------------------------
# Handles displaying of a form or a record.
#
my $self = shift;
# Initiate if we are passed in any arguments as options.
if (@_) { $self->init (@_); }
# Get the column hash and primary key
$self->{cols} = $self->{db}->cols unless exists $self->{cols};
$self->{pk} = [$self->{db}->pk] unless exists $self->{pk};
# Output
my $out = '';
# Hide the primary keys.
$self->{view_key} and push (@{$self->{view}}, @{$self->{pk}});
# Calculate the form values.
my $values = $self->_get_defaults;
# Now go through each column and print out a column row.
my @cols = $self->{db}->ordered_columns;
foreach my $col (@cols) {
# Run any code refs that have been setup.
if (exists $self->{code}->{$col} and (ref $self->{code}->{$col} eq 'CODE')) {
$out .= $self->{code}->{$col}->($self, $self->{cols}->{$col}, $values, $col);
next;
}
next if $self->_skip ($col);
# Set the form name (using increment for multiple if requested) and also the display name.
my $field_name = $self->{multiple} ? "$self->{multiple}-$col" : $col;
my $display_name = exists $self->{cols}->{$col}->{form_display} ? $self->{cols}->{$col}->{form_display} : $col;
my $value = $values->{$col};
my $disp = $self->{disp_form} ? $self->_get_form_display ($col) : $self->_get_html_display ($col);
$disp eq 'hidden' and push (@{$self->{hide}}, $col) and next;
$out .= qq!\n\t<td valign=texttop><font $self->{col_font}>!;
# Get the column display subroutine
$out .= $self->$disp( { name => $field_name, def => $self->{cols}->{$col}, value => $value });
$out .= qq!</font></td>\n!;
}
return $out;
}
sub display {
# ---------------------------------------------------------------
# Display a record as html.
#
my ($self, $opts) = @_;
$opts->{disp_form} = 0;
$opts->{disp_html} = 1;
return $self->_display ($opts || ());
}
sub _display {
# ---------------------------------------------------------------
# Handles displaying of a form or a record.
#
my $self = shift;
# Initiate if we are passed in any arguments as options.
if (@_) { $self->init (@_); }
# Get the column hash, primary keys, and unique columns
$self->{cols} = $self->{db}->cols unless exists $self->{cols};
$self->{pk} = [$self->{db}->pk] unless exists $self->{pk};
# Output
my $out = '';
# Hide the primary keys.
$self->{view_key} and push (@{$self->{view}}, @{$self->{pk}});
# Opening table.
$self->{extra_table} and ($out .= "<table border=1 cellpadding=0 cellspacing=0><tr><td>");
$out .= "<table $self->{table}>";
# Set the table widths depending on if we need a third column.
my ($cwidth, $vwidth);
if ($self->{search_opts}) { $cwidth = "30%"; $vwidth = "60%" }
else { $cwidth = "30%"; $vwidth = "70%" }
# Calculate the form values.
my $values = $self->_get_defaults;
# Now go through each column and print out a column row.
my @cols = $self->{db}->ordered_columns;
foreach my $col (@cols) {
# Run any code refs that have been setup.
if (ref $self->{code}->{$col} eq 'CODE') {
$out .= $self->{code}->{$col}->($self, $self->{cols}->{$col}, $values, $col);
next;
}
next if $self->_skip ($col);
# Set the form name (using increment for multiple if requested) and also the display name.
my $field_name = $self->{multiple} ? "$self->{multiple}-$col" : $col;
my $display_name = (exists $self->{cols}->{$col}->{form_display} and length $self->{cols}->{$col}->{form_display})
? $self->{cols}->{$col}->{form_display} : $col;
my $value = $values->{$col};
my $disp = $self->{disp_form} ? $self->_get_form_display ($col) : $self->_get_html_display ($col);
$disp eq 'hidden' and push (@{$self->{hide}}, $col) and next;
$out .= "<tr $self->{tr}><td $self->{td} width='$cwidth'><font $self->{col_font}>$display_name</font></td><td $self->{td} width='$vwidth'><font $self->{val_font}>";
# Get the column display subroutine
my $o = $self->$disp(
{
name => $field_name,
def => $self->{cols}->{$col},
value => (defined $value ? $value : '')
},
($values || {}),
$self
);
$out .= $o if defined $o;
# Add edit/delete links next to the primary key in search results.
if ($self->{mode} eq 'search_results' and @{$self->{pk}} == 1 and $col eq $self->{pk}->[0]) {
my $url = GT::CGI->url({ query_string => 0 }) . '?';
my @vals = GT::CGI->param('db');
for my $val (@vals) {
$url .= 'db=' . GT::CGI->escape($val) . ';';
}
chop $url;
$out .= qq| <small><a href="$url;do=modify_form;modify=1;1-$col=$value">edit</a> <a href="$url;do=delete_search_results;$col-opt=%3D;$col=$value">delete</a></small>|;
}
$out .= "</font></td>";
# Display any search options if requested.
if ($self->{search_opts}) {
$out .= qq~<td $self->{td} width="10%"><font $self->{val_font}>~;
$out .= $self->_mk_search_opts({
name => $field_name,
def => $self->{cols}->{$col},
pk => $self->{db}->_is_pk($col),
unique => $self->{db}->_is_unique($col)
}) || '&nbsp;';
$out .= "</font></td>";
}
$out .= "\n";
}
$out .= "</table>\n";
my %seen;
foreach (@{$self->{hide}}) {
next if $seen{$_}++;
my $field_name = $self->{multiple} ? "$self->{multiple}-$_" : $_;
my $val = $values->{$_};
if (exists $self->{cols}->{$_}->{time_check} and $self->{cols}->{$_}->{time_check}) {
$val ||= $self->_get_time ($self->{cols}->{$_});
}
defined $val or ($val = '');
GT::SQL::Display::HTML::_escape(\$val);
$out .= qq~<input type="hidden" name="$field_name" value="$val">~;
}
$self->{extra_table} and ($out .= "</td></tr></table>\n");
return $out;
}
1;
__END__
=pod
# Options for display forms/views:
# hide_timestamp => 1 # Do not display timestamp fields.
# search_opts => 1 # Add search options boxes.
# multiple => 1 # Prepend $multiple- to column names.
# defaults => 1 # Use .def defaults.
# values => {} # hash ref of values to use (overrides input)
# table => 'string' # table properties, defaults to 0 border.
# tr => 'string' # table row properties, defaults to none.
# td => 'string' # table cell properties, defaults to just aligns.
# extra_table => 0 # disable wrap form in extra table for looks.
# col_font => 'string' # font to use for columns, defaults to $FONT.
# val_font => 'string' # font to use for values, defaults to $FONT.
# hide => [] # display fields as hidden tags.
# view => [] # display fields as html with hidden tags as well.
# skip => [] # don't display array of column names.
=cut