# ==================================================================
# Gossamer Threads Module Library - http://gossamer-threads.com/
#
#       GT::SQL::Display::HTML
#       Author: Scott & Alex
#       $Id: HTML.pm,v 1.92 2005/04/05 18:47:08 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;
# ===============================================================
    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.92 $ =~ /(\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' ) {
            $values->{$col."_filename"} = $self->{values}->{$col."_filename"};
        }
        $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 SIZE="$self->{cols}->{$clean_name}->{form_size}"!;
    }
    elsif (exists $opts->{multiple} and $opts->{multiple} > 1) {
        $mult = qq!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}) ? " 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" 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}) ? " 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> ~) 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}) ? " 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$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]} });
    unless ( ( not $href and not $self->{file_use_path} ) or 
         ( not ( -e $opts->{value}) and $self->{file_use_path} ) ) {

        require GT::SQL::File;
        my $sfname  = $values->{$colname."_filename"};
        $out        = $sfname || GT::SQL::File::get_filename($fname ||= $href->{File_Name} );
        $self->{file_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" type=hidden 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 => ( $self->{file_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 => ( $self->{file_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>!;
            }
            $out .= qq~ <input type=checkbox name="$opts->{name}_del" value="delete"> Delete~;
        }
    }
    my $class = ($opts->{def}->{class}) ? " class='$opts->{def}->{class}'" : "";
    $out .= qq~<p><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}) ? " 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}) ? " 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}) ? " class='$opts->{def}->{class}'" : "";
    return qq~<textarea rows="$rows" cols="$cols" name="$name"$class>$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;' ], 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 || '';
    $$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.