# ==================================================================
# DBMan SQL - enhanced database management system
#
#   Website  : http://gossamer-threads.com/
#   Support  : http://gossamer-threads.com/scripts/support/
#   CVS Info : 087,064,093,087,084 
#   Revision : $Id: Home.pm,v 1.142 2002/09/11 22:13:07 bao Exp $
# 
# Copyright (c) 2001 Gossamer Threads Inc.  All Rights Reserved.
# Redistribution in part or in whole strictly prohibited. Please
# see LICENSE file for full details.
# ==================================================================

package Dbsql::Home;
# ==================================================================
    use strict;        
    use vars qw/@ISA $DEBUG $AUTOLOAD %COMPILE $LANGUAGE $GLOBALS/;
    use GT::Base qw/:all/;  # Imports $MOD_PERL $SPEEDY $PERSIST
    use Dbsql::Relation::Home;
    
    @ISA = qw/GT::Base Dbsql::Relation::Home/;

sub AUTOLOAD {
#---------------------------------------------------------------------------
    my $self = $_[0];
    my ($pkg, $what) = $AUTOLOAD =~ /^(.*)::([^:]+)$/;
    
# If they were looking for something that's not compiled, compile
# it and run it.
    if (exists $COMPILE{$what}) {
        eval "#line 0Dbsql::Home::$what\n$COMPILE{$what}";
        goto &{'Dbsql::Home::' . $what};
    }
    else {
        die "Invalid method: $what";
    }
# Pass back to the GT::Base AUTOLOAD.
    $GT::Base::AUTOLOAD = $AUTOLOAD;
    goto &GT::Base::AUTOLOAD;
}

sub DESTROY {}

sub process {
#----------------------------------------------------------------------
#   Process on every incoming request
#
    my ($self, @in) = @_;
    
# Find out what we have, and store the CGI values in self->{cgi}.
    my $opts = $self->common_param (@in) or return $self->error ($self->_language('REQUIRE_CGI'));    

# Set our internal vars.
    $self->{in}          = $opts->{in}   or return $self->error ($self->_language('REQUIRE_CGI'));
    $self->{cgi}         = $opts->{in}->get_hash;
    $self->{sql}         = $opts->{sql}  or return $self->error ($self->_language('REQUIRE_SQL'));
    $self->{root}        = $opts->{cfg}->{admin_root_path} or return $self->error ($self->_language('REQUIRE_ROOT'));
    $self->{glb_cfg}     = $opts->{cfg};
    $self->{cgi}->{db} ||= $self->{glb_cfg}->{default_table} ;

# Load table object and get an HTML object.
    $self->{cfg}         = $self->_load_cfg($self->{cgi}->{db}); 
    $self->{db}          = $self->{sql}->table($self->{cgi}->{db});
    $self->{disp}        = $self->{sql}->html($self->{db}, $self->{cgi});
    $self->_load_global; 

# Load related table object and get an HTML object.
    $self->check_relation() if ( $self->{cgi}->{sdb} and $self->{cgi}->{do} ne 'view_file' and $self->{cgi}->{do} ne 'download_file' );

# Check current query 
    $self->check_query()    if ( $self->{cgi}->{q} );

# Authenticate user.    
    $self->{user} = $self->_authenticate;

# Determine what to do:
    my $action = $self->_determine_action or return $self->error($self->_language('INVALID_ACTION'));

#------------demo code-----------

# Run the action.
    my ($tpl,$results) = GT::Plugins->dispatch_method ($self->{root}.'/Plugins/Dbsql', $action, $self, $action);
    $tpl and $self->print($tpl,$results);
}

sub print {
#----------------------------------------------------------------------
#   Print out the requested template
#
    my ($self, $template, $args) = @_;
    print $self->{in}->header;
    my $cgi = $self->{cgi};
    if ( $cgi ) {
        foreach my $key ( keys %$cgi ) {
            exists $args->{$key} or $args->{$key} = $cgi->{$key};
        }
    }
    my $user = $self->{user};
    if ( $user ) {
        foreach my $key ( keys %$user ) {
             exists $args->{$key} or $args->{$key} = $user->{$key};
        }
    }
    my $cfg = $self->{cfg};
    if ( $cfg ) {
        foreach my $key ( keys %$cfg ) {  
             exists $args->{$key} or $args->{$key} = $cfg->{$key};
        }
    }

    my $glb_cfg = $self->{glb_cfg};
    if ( $cfg ) {
        foreach my $key ( keys %$glb_cfg ) {
            if ( !exists $args->{$key} ) {
                $args->{$key} = $glb_cfg->{$key};
            }
        }
    }
# Export home for using in auto generate HTML.   
    $args->{home} = $self;
    my $dir_tmp   = $self->{cgi}->{t} || $self->{cfg}->{'template'} || $self->{glb_cfg}->{default_tpl};
    (-x $self->{root} . "/templates/$dir_tmp") or return print $self->{in}->header, $self->_language('INVALID_TEMPLATE', $dir_tmp);
    GT::Template->parse($template, $args, { print => 1, root => $self->{root} . "/templates/$dir_tmp" });
}

$COMPILE{home} = <<'END_OF_SUB';
sub home {
#---------------------------------------------------------------------------
    my $self = shift;
    my $msg  = shift;
    $msg     = ($self->_check_pers()) ? '' : $self->_language('PER_FAILURE') if ( !$msg );
    return ('home.html', {
                    header  => $self->_language('HEA_HOME'), 
                    msg     => $msg
    });        
}
END_OF_SUB


$COMPILE{view_file} = <<'END_OF_SUB';
sub view_file {
#---------------------------------------------------------------------------
    my ($self, $msg) = @_;
    my $table_name   = $self->{cgi}->{db};
    my $id           = $self->{cgi}->{id};
    my $cn           = $self->{cgi}->{cn};
    my $src          = $self->{cgi}->{src} || 'db';
    my $fname        = $self->{cgi}->{fname};

    return $self->error ($self->_language('FILE_UNKNOWN_REF')) if ( not ( $table_name and $id and $cn ) ) ;

    my $tbl   = $self->{db};
    my ( $fh, $mimetype, $size );
    if ( $src eq 'db' ) {
        eval { $fh = $tbl->file_info( $cn, $id ); };
        if ( $fh ) {
            $fname    = $fh->File_Name();
            $mimetype = $fh->File_MimeType();
            $size     = $fh->File_Size();
        }
    } 
    else {
        require GT::SQL::File;
        require GT::MIMETypes;
        eval { $fh = GT::SQL::File->open($fname) };
        $mimetype  = GT::MIMETypes->guess_type($fname);
        $fname     = GT::SQL::File::get_filename($fname);
    }

    if ( !$fh ) {
        return $self->error ($self->_language('FILE_ERR_VIEW'))
    }

    else {
        print $self->{in}->header(
            '-type'                  => $mimetype,
            '-Content-Length'        => $size,
            '-Content-Disposition'   => \("inline; filename=".$fname)
        );
        $fh->File_Binary() and binmode STDOUT;

        while ( read($fh, my $buffer, 4096) ) {
            print $buffer;
        }
    }
    return;
}
END_OF_SUB


$COMPILE{download_file} = <<'END_OF_SUB';
sub download_file {
#---------------------------------------------------------------------------
    my ($self, $msg) = @_;
    my $table_name   = $self->{cgi}->{db};
    my $id           = $self->{cgi}->{id};
    my $cn           = $self->{cgi}->{cn};
    my $src          = $self->{cgi}->{src} || 'db';
    my $fname        = $self->{cgi}->{fname};

    return $self->error ($self->_language('FILE_UNKNOWN_REF')) if ( not ( $table_name and $id and $cn ) ) ;

    my $tbl   = $self->{db};
    my ($fh, $mimetype, $size);
    if ( $src eq 'db' ) {
        eval { $fh = $tbl->file_info($cn, $id ); };
        if ( $fh ) {
            $fname    = $fh->File_Name();
            $mimetype = $fh->File_MimeType();
            $size     = $fh->File_Size();
        }
    } 
    else {
        require GT::SQL::File;
        require GT::MIMETypes;
        eval { $fh = GT::SQL::File->open($fname) };
        $mimetype = GT::MIMETypes->guess_type($fname);
        $fname    = GT::SQL::File::get_filename($fname);
    }

    if (!$fh) {
        return $self->error ($self->_language('FILE_ERR_DL'))
    }
    else {
        print $self->{in}->header(
            '-type'                      => 'application/download',
            '-Content-Length'            => $size,
            '-Content-Transfer-Encoding' => 'binary',
            '-Content-Disposition'       => \("attachment; filename=".$fname)
        );  

        $fh->File_Binary() and binmode STDOUT;

        while ( read ($fh, my $buffer, 4096) ) {
            print $buffer;
        }
    }
    return;

}
END_OF_SUB


$COMPILE{signup_form} = <<'END_OF_SUB';
sub signup_form {
#------------------------------------------------------------------------
# Sign up form 
#
    my($self,$msg) = @_;
    $self->{cfg}->{'auth_signup'} or return $self->login_form($self->_language('SIGNUP_AUTH'));
    $msg ||= $self->_language('MSG_SIGN_UP');
    return ('signup_form.html', {
                    header  => $self->_language('HEA_SIGNUP'),
                    msg     => $msg
    });
}
END_OF_SUB


$COMPILE{login_form} = <<'END_OF_SUB';
sub login_form {
#------------------------------------------------------------------------
# Login form 
#
    my ($self, $msg, $redirect) = @_;
    $msg ||= $self->{msg};
    $msg ||= $self->_language('MSG_LOGIN');
    $redirect &&= $self->{cfg}->{auth_logging};

    return ('login.html', {
                    header  => $self->_language('HEA_LOGIN'),
                    msg     => $msg,
                    redirect=> $redirect
    });
}
END_OF_SUB


$COMPILE{login} = <<'END_OF_SUB';
sub login {
#---------------------------------------------------------------------------
# Login users, if login failure display login_failure else display home page
#
    my $self = shift;          
    
    if ( !$self->{cgi}->{Username} or !$self->{cgi}->{Password} ) {
        return $self->login_form($self->_language('AUTH_FAILURE'));
    }

# Check that the user exists, and that the password is valid.
    $self->{user} = $self->_authenticate();
    if ( !$self->{user} ) {
        $self->auth_logging ("$self->{cgi}->{Username} failed to logon") if ($self->{cfg}->{log_file});
        return $self->login_form($self->_language('AUTH_FAILURE'));
    }            
# Return if user is not validated.
    return $self->login_form($self->_language('AUTH_FAIL_VAL')) if ($self->{user}->{Status} eq 'Not Validated');
    my $msg = ($self->_check_pers())? $self->_language('MSG_LOGGED',$self->{cgi}->{db}): $self->_language('PER_FAILURE',$self->{cgi}->{db});

# Create session
    my $results = Dbsql::Authenticate::auth('create_session', {Table => $self->{cfg}->{'user_table_use'}, Username => $self->{user}->{Username}}) or return $self->error("Unable to create session!");
    $self->{cgi}->{use_cookie} = $results->{use_cookie};
    $self->{cgi}->{session_id} = $results->{session_id};

    $self->auth_logging('log on ') if ( $self->{cfg}->{log_file} );
    return ('home.html', {
                    header => $self->_language('HEA_HOME'),
                    msg    => $msg
    });
}
END_OF_SUB


$COMPILE{signup} = <<'END_OF_SUB';
sub signup {
# --------------------------------------------------------
# Signs a new user up.
#
    my $self = shift;

    my $username = $self->{cgi}->{'Username'};
    my $password = $self->{cgi}->{'Password'};
    my $cpassword = $self->{cgi}->{'CPassword'};
    my $email    = $self->{cgi}->{'Email'};
# Verify that the user looks ok.
    return $self->signup_form($self->_language('INVALID_SIGNUP'))          if ( !$username or !$password or !$email );
    return $self->signup_form($self->_language('USER_REQUIRE_4-12_CHARS')) if ( length($username) < 3 or length($username) > 12 );
    return $self->signup_form($self->_language('USER_INVALIDEMAIL'))       if ( $email !~ /.+\@.+\..+/ );
    return $self->signup_form($self->_language('PASSWORD_NOT_MATCH'))      if ( $password ne $cpassword );
 
# Check if the username already exist and return alert.
    my $db   = $self->{sql}->table($self->{cfg}->{'user_table_use'});
    my $user = $db->get($username);
    return $self->signup_form($self->_language('USER_NAMETAKEN', $username)) if ( $user );

# Check that the email address doesn't already exist.
    my $hits = $db->count ( { Email => $email } );
    return $self->signup_form($self->_language('USER_EMAILTAKEN', $email))   if ( $hits );
        
# Add the user in, set defaults for fields not specified.
    $user = $self->{cgi};
    ($user->{view_p},$user->{add_p},$user->{delete_p},$user->{modify_p},$user->{admin_p}) = split(',',$self->{cfg}->{'auth_signup_permissions'});
# You can change the status as you desire. it can be 'Not Validated'
    $user->{Status} = 'Registered';
    my $def = $db->default || {};
    foreach ( keys %$def ) {
        $user->{$_} = $def->{$_} unless ( exists $user->{$_} );
    }  
    $db->add($user) or return $self->signup_form($self->_language('SIGNUP_USER_ERR'));
    $self->auth_logging("$username signed up") if ( $self->{cfg}->{log_file} );

# Print the welcome screen.
    return $self->login_form($self->_language('MSG_SIGNUP_SUCC', $username ));
}
END_OF_SUB


$COMPILE{log_off} = <<'END_OF_SUB';
sub log_off {
#--------------------------------------------------------------------------
# Log off and reset environment 
#
    my ($self, $msg)= @_;
    $msg ||= $self->_language('MSG_LOGOFF');
    $self->auth_logging('log off ') if ($self->{cfg}->{log_file});
    Dbsql::reset_env();
    Dbsql::Authenticate::auth_delete_session({ Table => $self->{cfg}->{'user_table_use'}, Username => $self->{user}->{Username} });    
    if ( $self->{cfg}->{auth_logging} ) {
        $self->login_form($msg, 1);
    }
    else {
        $self->login_form($msg);
    }
}
END_OF_SUB


$COMPILE{add_form} = <<'END_OF_SUB';
sub add_form {
# --------------------------------------------------------------------------
#   This will print the add form for the current tables that we are working 
#   with. All the options that were set in settings will apply to the html 
#   that is printed here.
#
    my ($self,$msg) = @_;
    return $self->home($self->_language('PER_ADD')) unless ( $self->{user}->{add_p} );

    $msg ||= $self->_language('ADD_MESSAGE');
    my $enctype;

    if ( $self->{cgi}->{sdb} and $self->{cgi}->{sdo} ) {
        $enctype = $self->{subfrm}->{db}->_file_cols() ? 'enctype="multipart/form-data"' : '';
    }
    else {
        $enctype = $self->{db}->_file_cols() ? 'enctype="multipart/form-data"' : '';
    }

    return ('add_form.html', {
                    header   => $self->_language('HEA_ADD'),
                    msg      => $msg,  
                    add_form => 1,
                    enctype  => $enctype,
    });
}
END_OF_SUB

$COMPILE{add_record} = <<'END_OF_SUB';
sub add_record {
#----------------------------------------------------------------------
    my $self = shift;
    return $self->home($self->_language('PER_ADD')) unless ( $self->{user}->{add_p} );

#------------demo code----------------

# add data to related table
    return $self->sadd_record() if ( $self->{cgi}->{sdb} and $self->{cgi}->{sdo} );

# Turn arrays into delimited fields
    $self->format_insert_cgi;
    if ( $self->{cfg}->{'auth_user_field'} ) {
        $self->{cgi}->{$self->{cfg}->{'auth_user_field'}} = $self->{user}->{'Username'};
    }

# Check foreign keys
    my $msg = $self->_check_fk();
    ($msg) and return $self->add_form($msg);

# Setup the language for GT::SQL.    
    local $GT::SQL::ERRORS->{ILLEGALVAL} = $self->_language('ADD_ILLEGALVAL');
    local $GT::SQL::ERRORS->{UNIQUE}     = $self->_language('ADD_UNIQUE');
    local $GT::SQL::ERRORS->{NOTNULL}    = $self->_language('ADD_NOTNULL');

    if ( defined (my $ret = $self->{db}->add($self->{cgi})) ) {
        $self->auth_logging('add record ') if ( $self->{cfg}->{log_file} );
        
#------------demo code-----------

        $self->add_success($ret);
    }
    else {
        local $^W;    
        my $error = $GT::SQL::error;
        $error =~ s/\n/<br>\n<li>/g;
        $self->add_form("<font color=red><ul><li>$error</ul></font>");
    }
}
END_OF_SUB

$COMPILE{add_success} = <<'END_OF_SUB';
sub add_success {
#-------------------------------------------------------------------------
#
    my ($self, $id) = @_;

    my $hsh;
    my $pk = $self->{db}->pk; 

    if ( $self->{db}->ai ) {   
        $hsh = $self->{db}->get($id, 'HASH');   
    }   
    else { 
        my $lookup = {};    
        foreach (@$pk) { $lookup->{$_} = $self->{cgi}->{$_}; }
        $hsh = $self->{db}->get($lookup, 'HASH');
    }     
    $self->{hsh} = $hsh;
    if ( $self->{cgi}->{sdb} and $#$pk == 0 ) {
        $self->{subfrm}->{value} = $hsh->{@$pk[0]};
        $self->{cgi}->{sfk}      = $hsh->{@$pk[0]};
    }
    return ('add_success.html', {
                    header  => $self->_language('HEA_ADDED'),
                    msg     => $self->_language('ADD_SUCCESSFULLY'),
                    %$hsh
    });
}
END_OF_SUB

$COMPILE{add_multi_form} = <<'END_OF_SUB';
sub add_multi_form {
#-----------------------------------------------------------------------------
# Add multiple form
#
    my ($self, $msg, $values, $rows) = @_;
    return $self->home($self->_language('PER_ADD')) unless ( $self->{user}->{add_p} );

    $rows ||= $self->{cgi}->{m};
    ($rows == 0) and return $self->add_form();

    $msg ||= $self->_language('ADD_MESSAGE');
    my $enctype = $self->{db}->_file_cols() ? 'enctype="multipart/form-data"' : '';
    return ('add_form.html', {
                    header   => $self->_language('HEA_ADD'),
                    msg      => $msg,  
                    add_form => 1,
                    enctype  => $enctype,
                    values   => $values,
                    m        => $rows,
    });

}
END_OF_SUB

$COMPILE{add_multi_records} = <<'END_OF_SUB';
sub add_multi_records {
#-----------------------------------------------------------------------------
# Add multiple records
#
    my $self = shift;
    return $self->home($self->_language('PER_ADD')) unless ( $self->{user}->{add_p} );

#------------demo code----------------

    my $rows = $self->{cgi}->{m};

   return $self->add_form($self->_language('MUL_ADD_ERR')) if ( $rows < 0 and $rows > 25 );
# Format the cgi for searching
    $self->format_search_cgi;

# Hash to handle errors if there are any errors.
    my $errors = {};

# Need to know the names of the columns for this Table.
    my @columns = keys %{$self->{db}->cols};

# Need to know the number of records added
    my $rec_added = 0;

# For through the record numbers. These are the values of the
# check boxes

# Setup the language for GT::SQL.    
    local $GT::SQL::ERRORS->{ILLEGALVAL} = $self->_language('ADD_ILLEGALVAL');
    local $GT::SQL::ERRORS->{UNIQUE}     = $self->_language('ADD_UNIQUE');
    local $GT::SQL::ERRORS->{NOTNULL}    = $self->_language('ADD_NOTNULL');

    foreach my $rec_num ( 1..$rows ) {

# The hash ref, we need, to modify a record.
        my $hash = {};

# For through the column names to build our modification hash
        foreach my $column ( @columns ) {
            $hash->{$column} = $self->{cgi}->{"$rec_num-$column"} if exists $self->{cgi}->{"$rec_num-$column"};
        }
        if ( $self->{cfg}->{'auth_user_field'} ) {
            $hash->{$self->{cfg}->{'auth_user_field'}}= $self->{user}->{'Username'};
        }        
# Add records and capture any errors.
        my $ret = $self->{db}->add($hash);
        if ( defined ($ret) ) {
            $rec_added++;
        }
        else {
            if ( $GT::SQL::error ) {
                my $error = $GT::SQL::error;
                $error =~ s/\n/<br>\n<li>/g;
                $errors->{$rec_num} = "<li>$error";
            }
        }
    }
#------------demo code-----------

    return ( keys %{$errors} ) ? $self->add_multi_results($rec_added,$errors) : $self->add_multi_results($rec_added);
}
END_OF_SUB

$COMPILE{add_multi_results} = <<'END_OF_SUB';
sub add_multi_results {
#------------------------------------------------------------------------
    my ($self, $num_added, $errors) = @_;

    return ('add_success.html', {
                header  => $self->_language('HEA_ADDED'),
                msg     => $self->_language('MUL_ADD_SUC', $num_added),
                m       => $num_added
    }) if ( !$errors );

    my @columns = keys %{$self->{db}->cols};
    my ($values, $msg, $rows);
    foreach my $rec ( keys %$errors ) {
        my $hsh;
        $msg .= $errors->{$rec};
        foreach ( @columns ) {
            $hsh->{$_} = $self->{cgi}->{"$rec-$_"};
        }
        $rows++;
        $values->{$rows} = $hsh;
    }
    $msg = "<font color=red>$msg</font>";
    return $self->add_multi_form($msg, $values, $rows);
}
END_OF_SUB

$COMPILE{modify_search_form} = <<'END_OF_SUB';
sub modify_search_form {
#-------------------------------------------------------------------------
#   The same thing just puts the message at the top of the
#   field. Great for errors.
#
    my ($self, $msg) = @_;
    return $self->home($self->_language('PER_MOD')) unless ( $self->{user}->{modify_p} );

# searching on related table
    return $self->smodify_search_results($msg) if ( $self->{cgi}->{sdb} and $self->{cgi}->{sdo} and $self->{cgi}->{sfk});

    $msg ||= $self->_language('MOD_SRC_MESSAGE');
    return ('modify_search_form.html', {
                    header  => $self->_language('HEA_SRC_MODIFY'),
                    msg     => $msg,
    });     
}   
END_OF_SUB

$COMPILE{modify_search_results} = <<'END_OF_SUB';
sub modify_search_results {
#----------------------------------------------------------------------
    my $self = shift;
    return $self->home($self->_language('PER_MOD')) unless ( $self->{user}->{modify_p} );

# Make sure the user passed in some values to search on
    $self->_check_opts or return $self->modify_search_form ($self->_language('SRC_FAILURE'));

# Format the cgi for searching
    $self->format_search_cgi;

# Check if users can delete only their own records
    if ( $self->{cfg}->{'auth_modify_own'} and $self->{cfg}->{'auth_user_field'} and !$self->{user}->{admin_p} ) {
        $self->{cgi}->{$self->{cfg}->{'auth_user_field'}}       = $self->{user}->{'Username'};
        $self->{cgi}->{"$self->{cfg}->{'auth_user_field'}-opt"} = '=';
    }

# Do the search and count the results.   
    my $sth  = $self->{db}->query_sth ($self->{cgi}) or return $self->modify_search_form($GT::SQL::error);
    my $hits = $self->{db}->hits();

# Return if we haven't found anything.
    if ( $hits == 0 ) {
#------------demo code-----------

        return $self->modify_search_form ($self->_language('SRC_NOTFOUND'));
    }
    
# Go straight to the modify form if we only have on result.
    if ( $hits == 1 and !$self->{cgi}->{sdo} ) {
        $self->{cgi}->{modify} = 0;
        my $row = $sth->fetchrow_hashref;
        foreach ( keys %$row ) {
            $self->{cgi}->{$_} = $row->{$_};
        }
        return $self->modify_form();
    }

# Build speed bar
    my $speedbar = '';
    if ( $hits > ($self->{cgi}->{mh} || 25) ) {
        my $name = GT::CGI->url(remove_empty => 1);
        $speedbar .= $self->{disp}->toolbar($self->{cgi}->{nh} || 1, $self->{cgi}->{mh} || 25, $hits, $name);
    }

# Return results
    my @output;
    my @pk = $self->{db}->pk;
    my $i = 1;
    while ( my $row = $sth->fetchrow_hashref ) {
        my $hidden;
        foreach my $key ( @pk ) {
            if ( $self->{db}->can ('_complete_name') ) {
                my $new = {};
                for ( keys %{$row} ) {
                    $new->{$self->{db}->_complete_name ($_)} = $row->{$_};
                }
                $row = $new;
            }
            my $val  = $row->{$key};
            $hidden .= qq~<input type=hidden name="$i-$key" value="$val">~;
        }
        $row->{hidden} = $hidden;
        

        push @output, $row;  
        $i++;
    }
    
    my $enctype = $self->{db}->_file_cols() ? 'enctype="multipart/form-data"' : '';

    return ('modify_search_results.html', {
                    header  => $self->_language('HEA_SRC_RESULT'),
                    results => \@output,
                    enctype => $enctype,
                    speedbar=> $speedbar,
                    msg     => $self->_language('SRC_RESULT', $hits),
                    hits    => $hits
    });
}
END_OF_SUB

$COMPILE{modify_form} = <<'END_OF_SUB';
sub modify_form {
#----------------------------------------------------------------------
    my ($self, $msg) = @_;
    return $self->home($self->_language('PER_MOD')) unless ( $self->{user}->{modify_p} );

# searching on related table
    if ( $self->{cgi}->{sdb} and $self->{cgi}->{sdo} and $self->{cgi}->{sfk} ) {
        ( $self->{cgi}->{sdo} == 1 ) ? return $self->smodify_search_results() 
                                     : return $self->smodify_form();
    }

    $msg ||= $self->_language('MOD_MESSAGE');  
    my $values;
    my $mod     = $self->{cgi}->{modify};
    if ( $self->{cgi}->{modify} == 0 ) {
        return $self->modify_search_form($self->_language('MUL_MOD_SUC',0)) if ( $self->{cgi}->{me} );
        $values = $self->{cgi};
    }
    else {
        my $lookup = {};
        my $pk     = $self->{db}->pk;
        foreach ( @$pk ) { $lookup->{$_} = $self->{cgi}->{"$mod-$_"}; }
        $values = $self->{db}->get ($lookup, 'HASH');
    }    
    my $enctype = $self->{db}->_file_cols() ? 'enctype="multipart/form-data"' : '';
    return ('modify_form.html', {
                    header      => $self->_language('HEA_MODIFY'),
                    msg         => $msg,%$values,
                    values      => $values,
                    enctype     => $enctype,
    });    
}
END_OF_SUB


$COMPILE{modify_record} = <<'END_OF_SUB';
sub modify_record {
#----------------------------------------------------------------------
    my $self = shift;

#------------demo code----------------

    return $self->home($self->_language('PER_MOD')) unless ( $self->{user}->{modify_p} );

# Modify a record in related table
    return $self->smodify_record() if ( $self->{cgi}->{sdb} and $self->{cgi}->{sdo} eq '2' );

# Format arrays for insertion
    $self->format_insert_cgi;

# Check if users can delete only their own records
    if ( $self->{cfg}->{'auth_modify_own'} and $self->{cfg}->{'auth_user_field'} and !$self->{user}->{admin_p} ) {
        my $pk = $self->{db}->{schema}->{pk};
        my $hash;
        ( ref $pk ) or return $self->modify_form($self->_language('ERR_PK'));
        
        %$hash = map {$_ => $self->{cgi}->{$_}} @$pk;
        my $result = $self->{db}->get($hash);
        ( $result ) or return $self->modify_search_form($self->_language('SRC_NOTFOUND'));

        my $userid = $result->{$self->{cfg}->{'auth_user_field'}};
        ( $userid eq $self->{user}->{'Username'} ) or return $self->modify_form($self->_language('ERR_MODIFY_OWN'));
        $self->{cgi}->{$self->{cfg}->{'auth_user_field'}} = $self->{user}->{Username};
    }

#Check foreign keys
    my $msg = $self->_check_fk();
    ( $msg ) and return $self->modify_form($msg);
# Setup the language for GT::SQL.    
    local $GT::SQL::ERRORS->{ILLEGALVAL} = $self->_language('ADD_ILLEGALVAL');
    local $GT::SQL::ERRORS->{UNIQUE}     = $self->_language('ADD_UNIQUE');
    local $GT::SQL::ERRORS->{NOTNULL}    = $self->_language('ADD_NOTNULL');

    if ( $self->{db}->modify ($self->{cgi}) ) {    
        $self->auth_logging('modify record ') if ($self->{cfg}->{log_file});
        return $self->modify_success;
    }
    else {
        local $^W;
        my $error = $GT::SQL::error;
        $error    =~ s/\n/<br>\n<li>/g;
        return $self->modify_form ("<ul><li><font color=red><b>$error</font></b></ul>");
    }
}
END_OF_SUB

$COMPILE{modify_success} = <<'END_OF_SUB';
sub modify_success {
#----------------------------------------------------------------------
    my ($self, $id) = @_;

    my $hsh;
    if ( $self->{db}->ai ) {   
        $hsh = $self->{db}->get ($id, 'HASH');   
    }   
    else { 
        my $lookup = {};    
        my $pk     = $self->{db}->pk;
        foreach (@$pk) { $lookup->{$_} = $self->{cgi}->{$_}; }
        $hsh = $self->{db}->get ($lookup, 'HASH');
    }
    return ('modify_success.html', {
                    header  => $self->_language('HEA_MODED'),
                    msg     => $self->_language('MOD_SUCCESSFULLY'),
                    values  => $hsh,
                    ($hsh) ? %$hsh : hsh => 1
    });
}
END_OF_SUB

$COMPILE{modify_multi_records} = <<'END_OF_SUB';
sub modify_multi_records {
#----------------------------------------------------------------------
# Modify multiple records
#
    my $self = shift;
    return $self->home($self->_language('PER_MOD')) unless( $self->{user}->{modify_p} );

#------------demo code----------------

# Format the cgi for searching
    $self->format_search_cgi;

# Hash to handle errors if there are any errors.
    my $errors = {};
    my $errcode = {};

# Need to know the names of the columns for this Table.
    my @columns = keys %{$self->{db}->cols};
# Need to know the number of records modified
    my $rec_modified = 0;

# For through the record numbers. These are the values of the
# check boxes
    my $modify = ( ref $self->{cgi}->{modify} eq 'ARRAY' ) ? $self->{cgi}->{modify} : [$self->{cgi}->{modify}];

    return $self->modify_search_form($self->_language('MUL_MOD_SUC',0)) if ( !$self->{cgi}->{modify} );

    my $pk;
# Check if users can delete only their own records
    if ( $self->{cfg}->{'auth_modify_own'} and $self->{cfg}->{'auth_user_field'} and !$self->{user}->{admin_p} ) {
        $pk = $self->{db}->{schema}->{pk};     
        ( ref $pk ) or return $self->modify_form ($self->_language('ERR_PK'));
    }

# Setup the language for GT::SQL.    
    local $GT::SQL::ERRORS->{ILLEGALVAL} = $self->_language('ADD_ILLEGALVAL');
    local $GT::SQL::ERRORS->{UNIQUE}     = $self->_language('ADD_UNIQUE');
    local $GT::SQL::ERRORS->{NOTNULL}    = $self->_language('ADD_NOTNULL');

    foreach my $rec_num ( @$modify ) {

# The hash ref, we need, to modify a record.
        my $change = {};

# Check if users can delete only their own records
        if ( $self->{cfg}->{'auth_modify_own'} and $self->{cfg}->{'auth_user_field'} and !$self->{user}->{admin_p} ) {
            my $cond;
            %$cond = map {$_ => $self->{cgi}->{"$rec_num-$_"}} @$pk;
            my $result = $self->{db}->get($cond);        
            ( $result ) or return $self->modify_search_form($self->_language('SRC_NOTFOUND'));

            my $userid = $result->{$self->{cfg}->{'auth_user_field'}};
            ($userid eq $self->{user}->{'Username'}) or return $self->modify_form($self->_language('ERR_MODIFY_OWN'));
            $self->{cgi}->{"$rec_num-$self->{cfg}->{'auth_user_field'}"} = $self->{user}->{Username}
        }

# For through the column names to build our modification hash
        foreach my $column ( @columns ) {
            $change->{$column} = $self->{cgi}->{"$rec_num-$column"} if exists $self->{cgi}->{"$rec_num-$column"};
        }

# Make the changes and capture any errors.
        my $ret = $self->{db}->modify($change);
        if ( defined ($ret) ) {
            $rec_modified++;
        }
        else {
            if ( $GT::SQL::error ){
                my $error = $GT::SQL::error;
                $error =~ s/\n/<br>\n<li>/g;
                $errors->{$rec_num} = "<li>$error";
            }
            $errcode->{$rec_num} = $GT::SQL::errcode if ( $GT::SQL::errcode );
        }
    }

# Return the results page with the proper arguments depending on if we got an error or not.
    return ( keys %{$errors} ) ? $self->modify_multi_results($rec_modified, $errors, $errcode) : $self->modify_multi_results($rec_modified);
}
END_OF_SUB

$COMPILE{modify_multi_results} = <<'END_OF_SUB';
sub modify_multi_results {
#------------------------------------------------------------------------
# modify multiple records result
#
    
    my ($self, $num_modified, $errors) = @_;
    return ('modify_success.html', {
                    header  => $self->_language('HEA_MODED'),
                    msg     => $self->_language('MUL_MOD_SUC',$num_modified),
                    me      => 1
    }) if ( !$errors );

    my @columns = keys %{$self->{db}->cols};
    my ($values, $msg, $rows);
    foreach my $rec ( keys %$errors ) {
        my $hsh;
        $msg .= $errors->{$rec};
        foreach ( @columns ) {
            $hsh->{$_} = $self->{cgi}->{"$rec-$_"};
        }
        $rows++;
        push @$values, $hsh;
    }
    $msg = "<font color=red>$msg</font>";
    return ('modify_search_results.html', {
                    header  => $self->_language('HEA_SRC_RESULT'),
                    results => $values,
                    msg     => $self->_language('MUL_MOD_FAL')."<BR>$msg",
                    hits    => $rows,
                    me      => 1
    });
}
END_OF_SUB

$COMPILE{delete_search_form} = <<'END_OF_SUB';
sub delete_search_form {
#----------------------------------------------------------------------
#   Produces the search form to search to delete records.
#
    my ($self, $msg) = @_;
    return $self->home($self->_language('PER_DEL')) unless ( $self->{user}->{delete_p} );

# searching on related table
    return $self->sdelete_search_results() if ( $self->{cgi}->{sdb} and $self->{cgi}->{sdo} and $self->{cgi}->{sfk} );

    $msg ||= $self->_language('DEL_SRC_MESSAGE');
    return ('delete_search_form.html', {
                    header  => $self->_language('HEA_SRC_DELETE'),
                    msg     => $msg,
    }); 
}
END_OF_SUB


$COMPILE{delete_search_results} = <<'END_OF_SUB';
sub delete_search_results {
#----------------------------------------------------------------------
    my $self = shift;
    return $self->home($self->_language('PER_DEL')) unless ( $self->{user}->{delete_p} );

# Make sure the user passed in some values to search on
    $self->_check_opts or return $self->delete_search_form($self->_language('SRC_FAILURE'));

# Format the cgi for searching
    $self->format_search_cgi;

# Check if users can delete only their own records
    if ( $self->{cfg}->{'auth_modify_own'} and $self->{cfg}->{'auth_user_field'} and !$self->{user}->{admin_p} ) {
        $self->{cgi}->{$self->{cfg}->{'auth_user_field'}}= $self->{user}->{'Username'};
        $self->{cgi}->{"$self->{cfg}->{'auth_user_field'}-opt"} = '=';
    }

# Do the search and count the results.   
    my $sth  = $self->{db}->query_sth($self->{cgi}) or return $self->delete_search_form($GT::SQL::error);
    my $hits = $self->{db}->hits();

# Return if we haven't found anything.
    if ( $hits == 0 ) {

#------------demo code-----------

        return $self->delete_search_form($self->_language('SRC_NOTFOUND'));
    }
    
# Build speed bar
    my $speedbar = '';
    if ( $hits > ($self->{cgi}->{mh} || 25) ) {
        my $name   = GT::CGI->url(remove_empty => 1);
        $speedbar .= $self->{disp}->toolbar( $self->{cgi}->{nh} || 1, $self->{cgi}->{mh} || 25, $hits, $name);
    }

# Return results
    my (@output);
    my @pk = $self->{db}->pk;
    my $i  = 1;
    while ( my $row = $sth->fetchrow_hashref ) {
        my $hidden;
        foreach my $key ( @pk ) {
            if ( $self->{db}->can ('_complete_name') ) {
                my $new = {};
                for ( keys %{$row} ) {
                    $new->{$self->{db}->_complete_name ($_)} = $row->{$_};
                }
                $row = $new;
            }
            my $val  = $row->{$key};
            $hidden .= qq~<input type=hidden name="$i-$key" value="$val">~;
        }
        $row->{hidden} = $hidden;


        push @output, $row;  
        $i++;
    }

    return ('delete_search_results.html', {
                    header  => $self->_language('HEA_SRC_RESULT'),
                    results => \@output,
                    speedbar=> $speedbar,
                    msg     => $self->_language('SRC_RESULT', $hits),
                    hits    => $hits
    });
}
END_OF_SUB



$COMPILE{delete_records} = <<'END_OF_SUB';
sub delete_records {
#----------------------------------------------------------------------
    my $self = shift;

#------------demo code----------------

    return $self->home($self->_language('PER_DEL')) unless ( $self->{user}->{delete_p} );

# Make sure we have something to delete.
    $self->{cgi}->{delete} or return $self->delete_search_form($self->_language('DEL_SUCCESSFULLY',0));

# If they selected only one record to delete we still need an array ref
    ref $self->{cgi}->{delete} eq 'ARRAY' or $self->{cgi}->{delete} = [$self->{cgi}->{delete}];

# Delete records in related table
    return $self->sdelete_records() if ( $self->{cgi}->{sdb} and $self->{cgi}->{sdo} and $self->{cgi}->{sfk} );

# Need to know the names of the columns for this Table.
    my @columns = keys %{$self->{db}->cols};

# Need to know the number of records modified
    my $rec_modified = 0;

# For through the record numbers. These are the values of the 
# check boxes
    foreach my $rec_num ( @{$self->{cgi}->{delete}} )  {
        my $change = {};
        foreach my $column ( @columns ) {
            $change->{$column} = $self->{cgi}->{"$rec_num-$column"} if exists $self->{cgi}->{"$rec_num-$column"};
        }

# Check for delete own record
        if ( $self->{cfg}->{'auth_modify_own'} and $self->{cfg}->{'auth_user_field'} and !$self->{user}->{admin_p} ) {
            my $rec = $self->{db}->get ($change); 
            next if ( $rec->{$self->{cfg}->{'auth_user_field'}} ne $self->{user}->{'Username'} );
        }
        next unless ( keys %$change );
        my $ret = $self->{db}->delete($change);
        $self->auth_logging('delete record ', $change) if ( $self->{cfg}->{log_file} );
        if ( defined $ret and ($ret != 0) ) {
            $rec_modified++;
        }
    }

#------------demo code----------------

# Return the results page with the proper arguments depending on if we got an error or not.
    return $self->delete_search_form($self->_language('DEL_SUCCESSFULLY', $rec_modified));
}
END_OF_SUB


$COMPILE{search_form} = <<'END_OF_SUB';
sub search_form {
#----------------------------------------------------------------------
# Search record
#
    my ($self, $msg) = @_;
    return $self->home($self->_language('PER_VIEW')) unless ( $self->{user}->{view_p} );
    $msg ||= $self->_language('SRC_MESSAGE');
    return ('search_form.html', {
                    header  => $self->_language('HEA_SEARCH'),
                    msg     => $msg,
    });
}
END_OF_SUB


$COMPILE{search_results} = <<'END_OF_SUB';
sub search_results {
#------------------------------------------------------------------------------
    my($self) = shift;
    return $self->home($self->_language('PER_VIEW')) unless ( $self->{user}->{view_p} );

# searching on related table
    return $self->ssearch_results() if ( $self->{cgi}->{sdo} and $self->{cgi}->{sfk} );


# Make sure the user passed in some values to search on
    $self->_check_opts or return $self->search_form($self->_language('SRC_FAILURE'));

# Format the cgi for searching
    $self->format_search_cgi;

# Check if users can view only their own record
    if ( $self->{cfg}->{'auth_view_own'} and $self->{cfg}->{'auth_user_field'} and !$self->{user}->{admin_p} ) {
        $self->{cgi}->{$self->{cfg}->{'auth_user_field'}} = $self->{user}->{'Username'};
        $self->{cgi}->{"$self->{cfg}->{'auth_user_field'}-opt"} = '=';
    }

# Do the search and count the results.
    my $sth  = $self->{db}->query_sth($self->{cgi}) or return $self->search_form($GT::SQL::error);
    my $hits = $self->{db}->hits();
    
# Return if we haven't found anything.
    if ( $hits == 0 ) {
        return $self->search_form ($self->_language('SRC_NOTFOUND'));
    }

# Build speed bar   
    my $speedbar = '';
    if ( $hits > ($self->{cgi}->{mh} || 25) ) {
        my $name   = GT::CGI->url(remove_empty => 1);
        $speedbar .= $self->{disp}->toolbar( $self->{cgi}->{nh} || 1, $self->{cgi}->{mh} || 25, $hits, $name);
    }
    
# Return results
    my (@output);
    while ( my $row = $sth->fetchrow_hashref ) {      

        push @output, $row;        
    }  
    
    return ('search_results.html', {
                    header  => $self->_language('HEA_SRC_RESULT'),
                    results => \@output,
                    speedbar=> $speedbar,
                    msg     => $self->_language('SRC_RESULT', $hits),
                    hits    => $hits
    });
}
END_OF_SUB


$COMPILE{admin_form} = <<'END_OF_SUB';
sub admin_form {
#---------------------------------------------------------------------
#   show admin form
#
    my ($self, $user, $msg) = @_;
    return $self->home($self->_language('PER_ADMIN')) unless ( $self->{user}->{admin_p} );    
    $user = admin_init_hash($self->{user}) if ( !$user );
    return ('admin_form.html', {
                    header           => $self->_language('HEA_ADMIN'), %$user,
                    db               => $self->{cgi}->{db},
                    password_confirm => $self->{cgi}->{password_confirm},
                    msg              => $msg
    });
}

END_OF_SUB


$COMPILE{admin_action} = <<'END_OF_SUB';
sub admin_action {
#---------------------------------------------------------------------
#   add/delete/edit user on this table
#
    my  $self = shift;    
    my $action = 'admin_inquire_user';
    $action = 'admin_edit_user'   if ( $self->{cgi}->{sub_edit} ); 
    $action = 'admin_delete_user' if ( $self->{cgi}->{sub_delete} ); 
    GT::Plugins->dispatch_method ($self->{root}.'/Plugins/Dbsql', $action, $self, $action);
}
END_OF_SUB


$COMPILE{admin_inquire_user} = <<'END_OF_SUB';
sub admin_inquire_user {
#----------------------------------------------------------------------
#   inquire a user
#
    my($self, $username, $msg) = @_;  
    $username  ||= $self->{cgi}->{users};
    my $user;
    my $db       = $self->{cgi}->{db};
    my $table    = $self->{sql}->table($self->{cfg}->{'user_table_use'});
    my $user_inf = $table->get($username,'HASH') || {};        
    if ( $user_inf->{Username} ) {
        $user_inf->{users} = $username;    
        my $user_src = $self->{cgi}->{a_Username};
        if ( $user_src ) {
            my $user_new  = $table->get($user_src) || {};
            if ( $user_new->{Username} ) {
                $user_inf = $user_new;
                $user_inf->{users} = $user_new->{Username};
            }
            else {
                $user_inf->{users} = $user_src;
            }
        }
        $user = ( $user_inf->{Username} ) ? admin_init_hash($user_inf, $user) : {};    
    }
    else {      
        foreach my $key ( keys % {$self->{sql}->table($self->{cfg}->{'user_table_use'})->cols} ) {
            exists $user->{'a_'.$key} or $user->{'a_'.$key} = '';
        }
        $user->{users} = '';
    }    
    $self->admin_form($user, $msg);
}
END_OF_SUB

$COMPILE{admin_edit_user} = <<'END_OF_SUB';
sub admin_edit_user {
#----------------------------------------------------------------------
#   edit/update a user
#
    my ($self) = shift;

    my ($msg, $action);
    my $new_username = $self->{cgi}->{user};  
    my $old_username = $self->{cgi}->{a_Username};
    my $cur_username = $self->{cgi}->{users};
    my $db           = $self->{cgi}->{db};    
    my $pwd_confirm  = $self->{cgi}->{password_confirm};

    $msg = ( $new_username ) ? Dbsql::user_validate($new_username,$self->{cgi}->{a_Password},$pwd_confirm) : Dbsql::user_validate($old_username,$self->{cgi}->{a_Password},($pwd_confirm)? $pwd_confirm : $self->{cgi}->{a_Password});
    return $self->admin_form($self->{cgi},$msg) if ( $msg );
    
    my $tbl_user = $self->{sql}->table($self->{cfg}->{'user_table_use'});
    my $hsh_user = $self->admin_get_values($tbl_user);

    if ( $new_username ) { # add new a user   
        $hsh_user->{Username} = $new_username;
        $tbl_user->add($hsh_user) or return $self->admin_form($self->{cgi},$self->_language('USER_ERROR',$GT::SQL::error)); #add user
        
        $self->{cgi}->{users}      = $new_username;
        $self->{cgi}->{a_Username} = $new_username;     
        $msg    = $self->_language('USER_ADD', $new_username);
        $action = "add user $new_username";        
    }
    else { # update a user        
        $tbl_user->update($hsh_user, {'Username' => $cur_username}) or return $self->admin_form($self->{cgi},$self->_language('USER_ERROR',$GT::SQL::error)); #update user
        $self->{cgi}->{users} = $old_username;
        if ( $cur_username eq $self->{user}->{Username} ) { #Reload information for current user
            return $self->log_off($self->_language('USER_UPDATE',$old_username)) if ( $cur_username ne $old_username );
            foreach my $key ( keys % $hsh_user ) {           
                $self->{user}->{$key} = $hsh_user->{$key};
            }
        }
        return $self->admin_form($self->{cgi},$self->_language('USER_ERROR',$GT::SQL::error)) if ( $GT::SQL::error );
        $msg    = $self->_language('USER_UPDATE', $old_username);
        $action = "update user $old_username";
    }
    $self->auth_logging('', '', $action) if ( $self->{cfg}->{log_file} );
    $self->admin_form($self->{cgi}, $msg);
}
END_OF_SUB


$COMPILE{admin_delete_user} = <<'END_OF_SUB';
sub admin_delete_user {
#----------------------------------------------------------------------
#   edit/update a user#
#
    my($self) = shift;

    my $username = $self->{cgi}->{users};
    $self->{sql}->table($self->{cfg}->{'user_table_use'})->delete({'Username' => $username}) or return $self->admin_form($self->{cgi},$self->_language('USER_ERROR', $GT::SQL::error));
        
    $self->auth_logging('', '', "delete user $username") if ( $self->{cfg}->{log_file} );
    if ( $username eq $self->{user}->{Username} ) {
        return $self->log_off($self->_language('USER_DELETE', $username));
    }
    return $self->admin_inquire_user($username, "User <b>$username</b> deleted."); #add user
}
END_OF_SUB


$COMPILE{admin_init_hash} = <<'END_OF_SUB';
sub admin_init_hash {
#----------------------------------------------------------------------
#   init value from a hash into a hash
#
    my ($hsh_src, $hsh_tar) = @_;
    if ( $hsh_src ) {
        foreach my $key ( keys % $hsh_src ) { exists $hsh_tar->{'a_'.$key} or $hsh_tar->{'a_'.$key} = $hsh_src->{$key} || ''; }
        exists $hsh_tar->{users} or $hsh_tar->{users} = $hsh_src->{users} || $hsh_src->{Username};
        return $hsh_tar;
    }
    return {};    
}
END_OF_SUB


$COMPILE{admin_get_values} = <<'END_OF_SUB';
sub admin_get_values {
#----------------------------------------------------------------------
#  Get value from form 
#
    my($self, $table) = @_;
    my($output, $cols);
    $cols = $table->cols;
    foreach my $key ( keys % $cols ) { $output->{$key} = $self->{cgi}->{'a_'.$key} || ''; }
    return ($output);
}
END_OF_SUB


$COMPILE{auth_logging} = <<'END_OF_SUB';
sub auth_logging {
#-------------------------------------------------------------------------
# Logs an action to the database. Takes as input an action, and 
# optionally a user id. If no user id is passed in, it get's one from    
#
    my($self, $action, $items, $message) = @_;   
    if ( !$message ) {
        if ( $items ) {
            foreach my $value ( values % $items ) { $message .= ($message) ? "-$value" : $value; }
        }
        else {
            my $pk = $self->{db}->{schema}->{pk}; 
            if ( $pk ) { #to have a primary key                    
                foreach ( @$pk ) { $message .= ($message) ? '-'.$self->{cgi}->{$_} : $self->{cgi}->{$_}; }
            }
        }
    }
    my @time  = localtime;
    my $date  = sprintf ("%04d-%02d-%02d %02d:%02d:%02d", $time[5] + 1900, $time[4] + 1, $time[3], $time[2], $time[1], $time[0]);
    my $ip    = $ENV{REMOTE_HOST} || $ENV{REMOTE_ADDR};
    my $uid   = $self->{user}->{Username};
    my $table = $self->{sql}->table($self->{cfg}->{log_file});
    $table->add( {'log_time'    => $date,
                  'action'      => $action.$message,
                  'user_id'     => $uid,
                  'ip'          => $ip,
                  'tablename'   => $self->{cgi}->{db}
    });          
}
END_OF_SUB

$COMPILE{owner} = <<'END_OF_SUB';
sub owner() {
#-----------------------------------------------------------------------------
# Print the record's owner 
#
    my $self = shift;
    my $oid = $self->{cgi}->{oid};    
    my @output;
    my $rs = $self->{sql}->table($self->{cfg}->{user_table_use})->get($oid);
    push @output, $rs if ( $rs );
    return ('owner_form.html', { owner  => \@output,
                                 header => $self->_language('HEA_OWNER'),
                                 msg    => $self->_language('MSG_OWNER'),
                                 hit    => ( $rs ) ? 1 : 0
    });
}
END_OF_SUB

$COMPILE{error} = <<'END_OF_SUB';
sub error {
#-----------------------------------------------------------------------------
#
    my $self = shift;
    my $msg = shift ;
    $msg &&= qq|<FONT COLOR="red"><B>$msg</B></FONT>|;
    $self->print ('error.html', {
                    header  => 'Error',
                    msg     => $msg
    });
    exit 0;
}
END_OF_SUB

sub _check_fk {
#-------------------------------------------------------------------------
# Check the related record is required in main table
#
    my $self = shift;
    my $sth = $self->{sql}->table('Dbsql_Relationships')->select({ Relatedname => $self->{cgi}->{db} });

    while ( my $rs = $sth->fetchrow_hashref ) {
        my $r = $self->{sql}->table($rs->{Tablename})->get({ $rs->{pk} => $self->{cgi}->{$rs->{fk}} });
        ( $r ) or return $self->_language('REL_ERROR_FK', $rs->{Tablename});
    }
}

sub format_insert_cgi {
#-----------------------------------------------------------------------------
#   
    my $self = shift;
    my $cols = ( $self->{cgi}->{sdb} and $self->{cgi}->{sdo} ) ? $self->{subfrm}->{db}->cols : $self->{db}->cols;
    foreach ( keys % $cols ) {
        if ( !exists $self->{cgi}->{$_} and uc($cols->{$_}->{form_type}) eq 'CHECKBOX' ) {
            $self->{cgi}->{$_} = '';
        }
        next unless ( ref ($self->{cgi}->{$_}) eq 'ARRAY' );
        $self->{cgi}->{$_} = join ($GT::SQL::Display::HTML::INPUT_SEPARATOR, sort (@{$self->{cgi}->{$_}}));
    }
}

sub format_search_cgi {
#-----------------------------------------------------------------------------
    my $self = shift;
    foreach ( keys %{$self->{db}->cols} ) {        
        next unless ( ref ($self->{cgi}->{$_}) eq 'ARRAY' );
        if ( exists ($self->{cgi}->{"$_-opt"}) and $self->{cgi}->{"$_-opt"} eq 'LIKE' ) {
            $self->{cgi}->{$_} = join ("$GT::SQL::Display::HTML::INPUT_SEPARATOR%", sort (@{$self->{cgi}->{$_}}));
        }
        else {
            $self->{cgi}->{$_} = join ($GT::SQL::Display::HTML::INPUT_SEPARATOR, sort (@{$self->{cgi}->{$_}}));
        }
    }
}

sub _check_opts {
#-----------------------------------------------------------------------------
#   This checks to make sure the user specified at least one
#   column to search on.
##
    my $self = shift;
    my $sel = 0;

# Relation does not plat fare :(
    my $cols = $self->{db}->cols;
    for ( keys %{$self->{cgi}} ) {
        my ($opt) = $_ =~ /\-([^-]+)$/;
        my $c     = $_;
        $c =~ s/\-$opt//;
        $sel = 1 if ( ( $self->{cgi}->{$_} =~ /\S/ ) and exists $cols->{$c} ) 
    }
    if ( ( exists $self->{cgi}->{query} and $self->{cgi}->{query} =~ /\S/ ) or ( exists $self->{cgi}->{keyword} and $self->{cgi}->{keyword} =~ /\S/) ) {
        $sel = 1;
    }
    $sel or return;
    return 1;
}

sub _check_pers {
#-----------------------------------------------------------------------------
# Permissions check
#
    my $self = shift;
    my @per = qw/add_p view_p delete_p modify_p admin_p/;
    foreach ( @per ) {
        if ( $self->{user}->{$_} eq '1' ) { return 1; }
    }
    return;
}

sub _language {
# --------------------------------------------------------------------
# Process a language request, it's only loaded once, and saved in 
# $LANGUAGE.
#
    my $self    = shift;
    my $code    = shift;
    my ($value) = @_;
#    my $template_set = $self->{cfg}->{template} || 'default';  # original code 
	my $template_set = (defined $self->{cgi}->{t}) ? $self->{cgi}->{t} : ($self->{cfg}->{template} || 'default');  # bugfix

    if ( defined $LANGUAGE->{$template_set} ) {
        if ( exists $LANGUAGE->{$template_set}->{$code} ) {
            my $msg = @_ ? sprintf ($LANGUAGE->{$template_set}->{$code}, @_) : $LANGUAGE->{$template_set}->{$code};
            $msg =~ s/<%value%>/$value/g;
            return $msg;
        }
        else {
            return $code;
        }
    }

# Load the template file, and return the parsed code.
    local ($!, $@);
    $LANGUAGE->{$template_set} = do "$self->{glb_cfg}->{admin_root_path}/templates/$template_set/language.txt";

    if ( exists $LANGUAGE->{$template_set}->{$code} ) {
        my $msg = @_ ? sprintf ($LANGUAGE->{$template_set}->{$code}, @_) : $LANGUAGE->{$template_set}->{$code};
        $msg =~ s/<%value%>/$value/g;
        return $msg;
    }
    else {
        return $code;
    }
}


sub _load_global {
#----------------------------------------------------------------------------
# Load our global template
#

# Load our global variables.
    my $self = shift;
#    my $template_set = $self->{cfg}->{template} || 'default';  # original code 
	my $template_set = (defined $self->{cgi}->{t}) ? $self->{cgi}->{t} : ($self->{cfg}->{template} || 'default');  # bugfix

    if ( !defined $GLOBALS->{$template_set} and ( -e "$self->{glb_cfg}->{admin_root_path}/templates/$template_set/globals.txt" ) ) {
        local ($@, $!);
        $GLOBALS->{$template_set} = do "$self->{glb_cfg}->{admin_root_path}/templates/$template_set/globals.txt";
    }

    if ( defined $GLOBALS->{$template_set} ) {
        $GLOBALS->{$template_set} ||= {};
        foreach my $key ( keys %{$GLOBALS->{$template_set}} ) {
            if ( !exists $self->{glb_cfg}->{$key} ) {
                if ( index ($GLOBALS->{$template_set}->{$key}, 'sub {') == 0 ) {
                    $self->{glb_cfg}->{$key} = sub {
                        my $code = eval "package Dbsql; $GLOBALS->{$template_set}->{$key}";
                        ref $code eq 'CODE' or die "Unable to compile '$key'. Reason: $@";
                        $code->(@_);
                    };
                }
                else {
                    $self->{glb_cfg}->{$key} = $GLOBALS->{$template_set}->{$key};
                }
            }
        }
    }
}

sub _determine_action {
#----------------------------------------------------------------------------
# Check valid action
#
    my $self = shift;    
    my $action = $self->{cgi}->{do} || undef;    
    if ( !$action ) {
        return ( $self->{cfg}->{'auth_no_authentication'} ) ? 'home' : 'login_form';           
    }
    return 'signup_form' if ( $self->{cfg}->{'auth_signup'} and $action eq 'signup_form' );
    return 'signup'      if ( $self->{cfg}->{'auth_signup'} and $action eq 'signup' );
    
    ( ( $action eq 'qsearch_form' or $action eq 'qsearch_results' ) and !$self->{cgi}->{q} ) and return;
    if ( !$self->{user} and $action ne 'login_form' ){
        $self->{msg} = $self->_language('INVALID_USER'); 
        return 'login_form' ;
    }
    return 'home' if ( $self->{cfg}->{'auth_no_authentication'} and $action eq 'log_off' );
    exists $COMPILE{$action} and return $action ;
    return;
}

sub _load_cfg {
#------------------------------------------------------------------------
#   Load config of a table
#
    my $self = shift;
    my $tablename = shift;
    ( -e "$self->{root}/defs/$tablename.def" ) or return $self->error($self->_language('DB_FAILURE',$tablename));
    my $cfg = $self->{sql}->table ('Dbsql')->get($tablename) or return $self->error($self->_language('REQUIRE_SETUP_DB',$tablename));

#   Check if there is any user table to use with current table or using default table Users;
    $cfg->{'user_table_use'} ||= $self->{glb_cfg}->{default_user_table};
    if ( $cfg->{'auth_no_authentication'} ) {        
        ($cfg->{view_p}, $cfg->{add_p}, $cfg->{delete_p}, $cfg->{modify_p}, $cfg->{admin_p}) = split(',', $cfg->{'auth_allow_default'});
    }
    return $cfg;
}

sub _authenticate {
#------------------------------------------------------------------------
#   Load information of a user
#
    my $self = shift;
    require Dbsql::Authenticate;
    if ( $self->{cfg}->{'auth_no_authentication'} ) {  
        my $per;
        ($per->{view_p}, $per->{add_p}, $per->{delete_p}, $per->{modify_p}, $per->{admin_p}) = split(',', $self->{cfg}->{'auth_allow_default'});
        $per->{admin_p} = 0;
        return $per;
    }

    if ( $self->{cgi}->{uid} eq 'default' ) {
        my $results = Dbsql::Authenticate::auth ('create_session', { Table => $self->{cfg}->{'user_table_use'}, Username => 'default' }) or return $self->error("Unable to create session!");
        $self->{cgi}->{use_cookie} = $results->{use_cookie};
        $self->{cgi}->{session_id} = $results->{session_id};
        my $per;
        ($per->{view_p}, $per->{add_p}, $per->{delete_p}, $per->{modify_p}, $per->{admin_p}) = split(',', $self->{cfg}->{'auth_allow_default'});
        $per->{admin_p} = 0;
        $per->{user_name} = 'default';
        $per->{Username}  = 'default';
        return $per;
    }    

# Authenticate the user. 
    Dbsql::Authenticate::auth('init');    
    my $username = $self->{cgi}->{Username};
    my $password = $self->{cgi}->{Password};
    my $tbl_name = $self->{db}->{name};

# Validate the username, either through logging on, or checking the
# session.
    my $valid_user;         
    if ( defined $username && defined $password ) {
        if ( Dbsql::Authenticate::auth('valid_user', { Table => $self->{cfg}->{'user_table_use'}, Username => $username, Password => $password }) ) {
            $valid_user = $username;
        }
    }
    else {
        my $results = Dbsql::Authenticate::auth('valid_session', { Table => $self->{cfg}->{'user_table_use'} });
        $valid_user = $results->{user_name};
        $self->{cgi}->{user_name}  = $valid_user;
        $self->{cgi}->{use_cookie} = $results->{use_cookie};
        $self->{cgi}->{session_id} = $results->{session_id};
    }

    return if ( !$valid_user );
    if ( $valid_user eq 'default' ) {
        my $per;
        ($per->{view_p}, $per->{add_p}, $per->{delete_p}, $per->{modify_p}, $per->{admin_p}) = split(',', $self->{cfg}->{'auth_allow_default'});
        $per->{admin_p} = 0;
        $per->{Username} = 'default';
        return $per;
    }

# We have a valid_user, now let's get the user from DBMan SQL
    return $self->{sql}->table($self->{cfg}->{'user_table_use'})->get($valid_user);       
}

if ( $PERSIST ) {
    foreach my $sub ( keys %COMPILE ) {
        local $SIG{__WARN__} = sub { warn "WARNING: ($sub) @_"; };
        eval "#line 0Dbsql::Home::$sub\n$COMPILE{$sub}";
        $@ and die "Unable to load '$sub' ($@)";
    }
}

1;