# ==================================================================
# Links SQL - enhanced directory management system
#
#   Website  : http://gossamer-threads.com/
#   Support  : http://gossamer-threads.com/scripts/support/
#   CVS Info : 087,068,083,090,083 
#   Revision : $Id: Tools.pm,v 1.85 2002/01/26 02:40:15 alex 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 Links::Tools;
# ==================================================================
    use strict;
    use Links qw/$IN $DB $CFG/;
    use vars qw/%STATUS_OK %STATUS_BAD %STATUS_NEW $LANGUAGE/;

    %STATUS_OK = (
        200, "OK 200",
        201, "CREATED 201",
        202, "Accepted 202",
        203, "Partial Information 203",
        302, "Found, but data resides under different URL (add a /)",
        301, "Found, but moved",
        303, "Method"
    );

    %STATUS_BAD = (
        -1,  "Could not lookup server",
        -2,  "Could not open socket",
        -3,  "Could not bind socket",
        -4,  "Could not connect",
        -5,  "Bad URL format",
        -6,  "Could not resolve host name",
        -7,  "ID could not be resolved",
        -8,  "Non parseable response",
        204, "No Response 204",
        304, "Not Modified",
        400, "Bad request",
        401, "Unauthorized",
        402, "PaymentRequired",
        403, "Forbidden",
        404, "File Not found",
        405, "Method Not Allowed",
        407, "Unknown Request Method",
        500, "Internal Error",
        501, "Not implemented",
        502, "Service temporarily overloaded",
        503, "Gateway timeout ",
        600, "Bad request",
        601, "Not implemented",
        602, "Connection failed (host not found?)",
        603, "Timed out"
    );

    %STATUS_NEW = (
         0,  "New Link, UNCHECKED"
    );

sub status {
# ------------------------------------------------------------------
# Display the status of the links.
#
    my $db = $DB->table('Links');
    $db->select_options ( "GROUP BY Status" );
    my $sth = $db->select ( ["Status", "COUNT(*)"] ) or die "Query Error: $GT::SQL::error";
    my ($good, $bad, $all, $new, $status);
    $good = $bad = $all = $new = 0;
    while (my ($s, $c) = $sth->fetchrow_array) {
        CASE: {
            exists $STATUS_OK{$s}  and $good += $c, last CASE;
            exists $STATUS_BAD{$s} and $bad  += $c, last CASE;
            $new += $c;
        };
        $all += $c;
        $status->{$s} = $c;
    }
    my $out = '';
    my $font = 'font face="Tahoma,Arial,Helvetica" size="2"';
    foreach my $s (sort { $a <=> $b } keys %$status) {
        $out .= qq!<tr><td><$font>!;
        CASE: {
            exists $STATUS_OK{$s}  and ($out .= qq!<font color="green">$status->{$s}</font></td><td><a href="admin.cgi?do=page&page=tools_view_status.html&status=$s"><$font color="green">$STATUS_OK{$s}</font></a></td></tr>!), last CASE;
            exists $STATUS_BAD{$s} and ($out .= qq!<font color="red">$status->{$s}</font></td><td><a href="admin.cgi?do=page&page=tools_view_status.html&status=$s"><$font color="red">$STATUS_BAD{$s}</font></a></td></tr>!), last CASE;
            $out .= $status->{$s} . qq!</td><td><a href="admin.cgi?do=page&page=tools_view_status.html&status=$s"><$font color="blue">$STATUS_NEW{$s}</font></a></td></tr>!;
        }
    }
    if (! $out) {
        $out = qq!<tr><td><font face="Tahoma,Arial,Helvetica" size="2">0</font></td><td><font face="Tahoma,Arial,Helvetica" size="2">$STATUS_NEW{0}</font></td></tr>!;
    }
    return { Good => $good, Bad => $bad, All => $all, New => $new, Status => $out };
}

sub view_status {
# ------------------------------------------------------------------
# Displays a page of links based on status in table format.
#
    my $db = $DB->table('Links');

# First take care of any deletes.
    if ($IN->param('delete')) {
        foreach my $key ($IN->param('delete')) {
            # ...
        }
    }

# Now display the list of links.
    my $status;
    if ($IN->param('status') eq 'check_good') {
        $status = join (",", keys %STATUS_OK);
    }
    elsif ($IN->param('status') eq 'check_bad') {
        $status = join (",", keys %STATUS_BAD);
    }
    elsif ($IN->param('status') eq 'check_new') {
        $status = join (",", keys %STATUS_NEW);
    }
    elsif ($IN->param('status') eq 'check_all') {
        $status = join (",", keys %STATUS_BAD, keys %STATUS_OK, keys %STATUS_NEW);
    }
    else {
        $status = join (",", $IN->param('status'));
    }
    if ($status eq '') {
        return { output => '', total => 0 };
    }
    my $cond = new GT::SQL::Condition;
    $cond->add ("Status", "IN", \"($status)");
    my $mh = $IN->param('mh') || 25;
    my $nh = $IN->param('nh') || 1;
    my $offset = ($nh-1) * $mh;

    $db->select_options ("ORDER BY Status, URL", "LIMIT $offset, $mh");
    my $sth = $db->select ($cond, ['ID', 'URL', 'Title', 'Status']);
    my $total       = $db->hits;
    my $old_status  = '';
    my $out         = '';
    my $vdb         = $DB->table('Verify');

    while (my $link = $sth->fetchrow_hashref) {
        if ($link->{Status} ne $old_status) {
            my $name = $STATUS_OK{$link->{Status}} || $STATUS_BAD{$link->{Status}} || $STATUS_NEW{$link->{Status}};
            $out .= qq~
<tr><td colspan=2 bgcolor="#dddddd"><font face="Tahoma,Arial,Helvetica" size="2"><b>$link->{Status} - $name</b><br>
You can <a href="admin.cgi?do=delete_search_results&db=Links&Status=$link->{Status}">Delete</a> all entries with this status or
        <a href="nph-verify.cgi?do=check_links&method=6&status=$link->{Status}">Recheck</a> all entries.
</td></tr>
            ~;
            $old_status = $link->{Status};
        }
        $vdb->select_options ("ORDER BY Date_Checked DESC", "LIMIT 10");
        my $sth2 = $vdb->select ( { LinkID => $link->{ID} }, ['Status', 'Date_Checked'] );
        my $history;
        while (my $verify = $sth2->fetchrow_hashref) {
            if ($STATUS_OK{$verify->{Status}}) {
                $history .= qq~$verify->{Date_Checked} - <font color="green">$verify->{Status}</font><br>~;
            }
            elsif ($STATUS_BAD{$verify->{Status}}) {
                $history .= qq~$verify->{Date_Checked} - <font color="red">$verify->{Status}</font><br>~;
            }
            else {
                $history .= qq~$verify->{Date_Checked} - $verify->{Status}<br>~;
            }
        }
        $history = "<font face='Tahoma,Arial,Helvetica' size='2'>$history</font>";

        $out .= qq~
<tr><td valign=top><font face='Tahoma,Arial,Helvetica' size='2'>
    <input type="checkbox" name="delete" value="$link->{ID}">
    <input type="hidden" name="$link->{ID}-ID" value="$link->{ID}">
    $link->{ID} - <a href="$link->{URL}">$link->{Title}</a> - 
        [ <a href="admin.cgi?do=modify_form&db=Links&modify=1&1-ID=$link->{ID}">Modify</a> | 
          <a href="nph-verify.cgi?do=check_links&method=7&ID=$link->{ID}">Recheck</a> ]
    </font></td>
    <td valign=top>$history</td>
</tr>
        ~;
    }
    my $url     = $IN->url;
    my $html    = $DB->html(['Links'], $IN);
    my $toolbar = $html->toolbar($nh, $mh, $total, $url);

    return { output => $out, toolbar => $toolbar, total => $total };
}

sub check_duplicates {
# ------------------------------------------------------------------
# Displays a list of duplicate URL's.
#
    my $db = $DB->table('Links');
    my $nh = $IN->param('nh') || 1;
    my $mh = $IN->param('mh') || 10;
    my $begin = ($nh - 1) * $mh;
    my $end   = $begin + $mh;

# We turn on big tables as this is usually a large query for MySQL.
    if (lc $db->{connect}->{driver} eq 'mysql') {
        my $sth = $db->prepare ("SET OPTION SQL_BIG_TABLES = 1");
        $sth->execute;
    }

# Now get URL's and Counts.
    $db->select_options ("GROUP BY URL", "ORDER BY hits DESC");
    my $sth     = $db->select ( ['URL', 'COUNT(*) AS hits'], GT::SQL::Condition->new ('URL', '<>', "", 'URL', '<>', 'http://') );
    my $row_num = -1;
    my $total   = 0;
    my $dupes   = '';
    my %seen;
    while (my ($url, $count) = $sth->fetchrow_array) {
        last if ($count == 1);
        $total += $count;
        $row_num++;
        $seen{$url} = 1;
        next if ($row_num < $begin);
        last if ($row_num >= $end);

        my $sth2 = $db->select( { URL => $url }, ['ID','Title'] );
        $dupes .= qq~
<tr><td bgcolor="#dddddd"><font face="Tahoma,Arial,Helvetica" size="2"><b>$url - $count</b></font>
</td></tr>
        ~;
        while (my ($id, $title) = $sth2->fetchrow_array) {
            my $cats = $db->get_categories($id);
            my ($cid, $cname) = each %$cats;

            $dupes .= qq~
<tr><td valign=top>
    <font face="Tahoma,Arial,Helvetica" size="2">
        <input type="checkbox" name="delete" value="$id">
        <input type="hidden" name="$id-ID" value="$id">
        $id - <a href="$url">$title</a> - $cname -
        [ <a href="admin.cgi?do=modify_form&db=Links&modify=1&1-ID=$id">Modify</a> ]
    </font>
</td></tr>
            ~;
        }
    }
    while (my ($url, $count) = $sth->fetchrow_array) {
        last if ($count == 1);
        $seen{$url} = 1;
        $total += $count;
    }
    my $url     = $IN->url ( query_string => 1, absolute => 0 );
    my $html    = $DB->html(['Links'], $IN);
    my $hits    = scalar keys %seen;
    my $toolbar = $html->toolbar($nh, $mh, $hits, $url);

    return { total => $total, output => $dupes, toolbar => $toolbar, number_urls => $hits };
}

sub language_editor {
# ------------------------------------------------------------------
# Loads the language file editor.
#
    my $selected_dir  = $IN->param('tpl_dir')  || $CFG->{build_default_tpl} || 'default';
    
    my $dir  = $CFG->{admin_root_path} . "/templates/" . $selected_dir;
    my $file = 'language.txt';
    my $lang = GT::Config->load ("$dir/$file", { create_ok => 1, inheritance => 1, local => 1, cache => 1 });
    my $font = 'face="Tahoma,Arial,Helvetica" size="2"';
    my $message = '';
    if ($IN->param('save')) {
        if (-e "$dir/$file" and ! -w _) {
            $message = "Unable to overwrite file: $file (permission denied). Please set permissions properly and save again.";
        }
        elsif (! -e _ and ! -w $dir) {
            $message = "Unable to create new files in directory $selected_dir. Please set permissions properly and save again.";
        }
        else {
            foreach my $code ($IN->param()) {
                next unless ($code =~ /^save-(.*)/);
                my $key = $1;
                if ($IN->param("del-$key")) {
                    delete $lang->{$key};
                    next;
                }
                my $var = $IN->param($code);
                $var =~ s/\r?\n/\n/g;  # Remove windows linefeeds.
                $lang->{$key} = $var;
            }
            if ($IN->param('new') and $IN->param('new-val')) {
                my $var = $IN->param('new-val');
                $var =~ s/\r?\n/\n/g;
                $lang->{$IN->param('new')} = $var;
            }
            $lang->save;
            $message = "Changes saved successfully.";
        }       
    }

# Load the language file.
    my $prefix = $IN->param('prefix');
    my %prefix_list;
    my $table = "<table border=0 width=100%><tr><td><font $font><b>Code</b></font></td><td><font $font><b>Description</b></font></td><td><font $font><b>Delete</b></font></td></tr>";
    foreach my $code (sort keys %$lang) {
        if ($code =~ /^(.*?)_/) {
            $prefix_list{$1}++;
        }
        next if ($prefix and $code !~ /^$prefix/);
        my $str = $IN->html_escape($lang->{$code});
        $table .= qq~<tr><td valign=top><font $font>$code</font></td><td><textarea rows=5 cols=40 name='save-$code'>$str</textarea></td><td><input type=checkbox name="del-$code" value="1"></td></tr>~;
    }
    $table .= qq~<tr><td valign=top><nobr><font $font>New: <input name="new" size=10 value=""></font></nobr></td><td><textarea rows=5 cols=40 name='new-val'></textarea></td><td>&nbsp;</td></tr></table>~;

    my $prefix_output;
    foreach my $prefix (sort keys %prefix_list) {
        $prefix_output .= qq~
<a href="admin.cgi?do=page&page=build_lang.html&prefix=$prefix&tpl_dir=$selected_dir">$prefix ($prefix_list{$prefix})</a> |~;
    }
    chop $prefix_output if ($prefix_output);

    my $d_select_list = template_dir_select ($selected_dir);

    return { language_table => $table, dir_select => $d_select_list, message => $message, prefix_list => $prefix_output };
}

sub global_editor {
# ------------------------------------------------------------------
# Loads the global template vars.
#
    my ($dir, $font, $file, $message, $table);
    my $selected_dir  = $IN->param('tpl_dir')  || $CFG->{build_default_tpl} || 'default';
    
    $dir  = $CFG->{admin_root_path} . "/templates/" . $selected_dir;
    $file = 'globals.txt';

    my $globals = GT::Config->load ("$dir/$file", { create_ok => 1, inheritance => 1, local => 1, cache => 1 });

    $font = 'face="Tahoma,Arial,Helvetica" size="2"';

    if ($IN->param('save')) {
        $file = 'globals.txt';
        if (-e "$dir/$file" and ! -w _) {
            $message = "Unable to overwrite file: $file (permission denied). Please set permissions properly and save again.";
        }
        elsif (! -e _ and ! -w $dir) {
            $message = "Unable to create new files in directory $selected_dir. Please set permissions properly and save again.";
        }
        else {            
            foreach my $code ($IN->param()) {
                next unless ($code =~ /^save-(.*)/);
                my $key = $1;
                if ($IN->param("del-$key")) { delete($globals->{$key}); next }; 
                my $var = $IN->param($code);
                $var =~ s/\r?\n/\n/g;  # Remove windows linefeeds.
                $globals->{$key} = $var;
            }
            if ($IN->param('new') and $IN->param('new-val')) {
                my $var = $IN->param('new-val');
                $var =~ s/\r?\n/\n/g;
                $globals->{$IN->param('new')} = $var;
            }
            $globals->save;
            $message = "Changes saved successfully.";
        }       
    }

# Load the globals file.
    $table = "<table border=0 width=100%><tr><td><font $font><b>Code</b></font></td><td><font $font><b>Description</b></font></td><td><font $font><b>Delete</b></font></td></tr>";
    foreach my $code (sort keys %$globals) {
        my $lang = $IN->html_escape($globals->{$code});
        $table .= qq~<tr><td valign=top><font $font>$code</font></td><td><textarea rows=5 cols=40 name='save-$code' wrap="off">$lang</textarea></td><td><input type=checkbox name="del-$code" value="1"></td></tr>~;
    }
    $table .= qq~<tr><td valign=top><nobr><font $font>New: <input name="new" size=10 value=""></font></nobr></td><td><textarea wrap="off" rows=5 cols=40 name='new-val'></textarea></td><td>&nbsp;</td></tr></table>~;

    my $d_select_list = template_dir_select ($selected_dir);

    return { global_table => $table, dir_select => $d_select_list, message => $message };
}

sub template_editor {
# ------------------------------------------------------------------
# Loads the template editor.
#
    require GT::Template::Editor;
    Links::init_date();

    my $editor = new GT::Template::Editor (
                    root        => $CFG->{admin_root_path} . '/templates',
                    default_dir => $CFG->{build_default_tpl},
                    backup      => 1,
                    cgi         => $IN,
                    date_format => $CFG->{date_user_format} . ' %hh%:%mm%:%ss%'
                );
    return $editor->process;
}

sub template_dir_select {
# ------------------------------------------------------------------
# Returns a select list of template directories.
#
    my ($dir, $file, @dirs);
    ref $_[0] and shift;        # Can be called from a template where first argument is a hash ref of tags.
    my $selected_dir = shift || $CFG->{build_default_tpl} || 'default';
    my $name         = shift || 'tpl_dir';
    my $no_php       = shift || 0;
    
    $dir = $CFG->{admin_root_path} . "/templates";
    opendir (TPL, $dir) or die "unable to open directory: '$dir' ($!)";
    while (defined ($file = readdir(TPL))) {
        next if ($file =~ /^\.\.?$/);
        next if ($file eq 'admin' or $file eq 'help');
        next if ($no_php and $file =~ /_php$/);
        next unless (-d "$dir/$file");
        push @dirs, $file;
    }
    closedir (TPL);

    my $d_select_list = "<select name='$name'>";
    foreach (sort @dirs) {
        ($selected_dir eq $_) ? ($d_select_list .= "<option selected>$_") : ($d_select_list .= "<option>$_");
    }
    $d_select_list .= "</select>";
    return $d_select_list;
}

sub validate_links {
# ------------------------------------------------------------------
# Display a list of links waiting to be validated. 
#
    my $db       = $DB->table ('Links');
    my $cat_link = $DB->table ('CatLinks');
    my $user_db  = $DB->table ('Users');
    my $html     = $DB->html ( $db, $IN );
    my $font     = 'font face="Tahoma,Arial,Helvetica" size="2"';
    my $nh       = $IN->param('nh') || 1;
    my $mh       = $IN->param('mh') || 5;

# Process any actions.
    my $results  = _validate ($db);

# Clear our cgi so we don't cause conflicts.
    $html->{input} = {};

# Get a list of links awaiting validation.
    my $sth   = $db->query_sth ( { 
                                    isValidated => 'No', 
                                    mh => $mh, 
                                    nh => $nh,
                                    sb => 'Add_Date',
                                    so => 'DESC'
                            });
    my $total = $db->hits;
    my $i     = 0;

    my $output = '';
    while (my $link = $sth->fetchrow_hashref) {
        $i++;
        my $sth2 = $cat_link->select ( { LinkID => $link->{ID} }, ['CategoryID'] );
        my @cat_ids = ();
        while (my ($cat) = $sth2->fetchrow_array) {
            push @cat_ids, $cat;
        }
        $link->{'CatLinks.CategoryID'} = \@cat_ids;
        my $form = $html->form ( { values => $link, extra_table => 0, mode => 'validate', view_key => 1, multiple => $i, file_field => 1, file_delete => 1 } );

# Load reason.
        my $user   = $user_db->get($link->{LinkOwner});
        @{$user}{keys %$link} = (values %$link);
        my $reason = Links::user_page ('email-add.txt', $user);

        $output .= qq~
<table border=1 cellpadding=0 cellspacing=0 width=500>
    <tr><td>$form</td></tr>
    <tr><td>
        <table border=0 cellpadding=3 cellspacing=2>
            <tr><td valign=top rowspan=2><$font><input type="radio" name="validate-$link->{ID}" value="validate"> 
                                Validate<br><font size=1>
                                            <a href="$link->{URL}" target="validate">view</a> |
                                            <a href="admin.cgi?db=Links&do=search_results&URL=$link->{URL}&URL-opt=LIKE&isValidated=Yes" target="duplicate">check</a>
                                            </font>
                    </font>
                </td>
                <td valign=top><$font><input type="radio" name="validate-$link->{ID}" value="delete">
                                Delete without reason.
                    </font>
                </td>
                <td valign=top><$font><input type="radio" name="validate-$link->{ID}" value="email">
                                Validate and email reason.
                    </font>
                </td>
            </tr>
            <tr>
                <td colspan=2>
                    <textarea name="reason-$link->{ID}" rows=5  wrap="off" cols=40>$reason</textarea>
                </td>
            </tr>
        </table>
    </td></tr>
</table>
<br>
        ~;
    }
    my $toolbar;
    if ($total > $mh) {
        $toolbar = $html->toolbar($nh, $mh, $total, GT::CGI->url);
    }
    return { output => $output, results => $results, total => $total, toolbar => $toolbar };
}

sub validate_changes {
# ------------------------------------------------------------------
# Display a list of links waiting to be validated. 
#
    my $db       = $DB->table ('Links');
    my $chg_db   = $DB->table ('Changes');
    my $cat_link = $DB->table ('CatLinks');
    my $user_db  = $DB->table ('Users');
    my $html     = $DB->html ( $db, $IN );
    my $font     = 'font face="Tahoma,Arial,Helvetica" size="2"';
    my $nh       = $IN->param('nh') || 1;
    my $mh       = $IN->param('mh') || 5;

# Process any actions.
    my $results  = _validate ($db);

# Get a list of links awaiting validation.
    my $sth   = $chg_db->query_sth ( LinkID => '*' );
    my $total = $chg_db->hits;
    my $i     = 0;

    my $output = '';
    while (my $link_data = $sth->fetchrow_hashref) {
        $i++;
        my $link = eval $link_data->{ChgRequest};
        my $user = $user_db->get ($link->{LinkOwner});
        my $update_user = '';
        $link->{$i . "-CatLinks.CategoryID"} = $link->{'CatLinks.CategoryID'};
        my $form = $html->form ( { values => $link, extra_table => 0, mode => 'validate', view_key => 1, multiple => $i, file_field => 1, file_delete => 1, file_use_path => 1 } );


# Load reason.
        @{$user}{keys %$link} = (values %$link);
        my $reason = Links::user_page ('email-val.txt', $link);

        $output .= qq~
<table border=1 cellpadding=0 cellspacing=0 width=500>
    <tr><td>$form</td></tr>
    <tr><td>
        <table border=0 cellpadding=3 cellspacing=2>
            <tr><td valign=top rowspan=2><$font>
                                <input type="radio" name="validate-$link->{ID}" value="modify"> 
                                Modify<br><font size=1>
                                            <a href="$link->{URL}" target="modify">view</a> |
                                            <a href="admin.cgi?db=Links&do=search_results&ID=$link->{ID}" target="duplicate">original</a>
                                            </font>
                    </font>
                </td>
                <td valign=top><$font><input type="radio" name="validate-$link->{ID}" value="deletechange">
                                Delete Change without reason.
                    </font>
                </td>
                <td valign=top><$font><input type="radio" name="validate-$link->{ID}" value="emailchange">
                                Delete Change and email reason.
                    </font>
                </td>
            </tr>
            <tr>
                <td colspan=2>
                    <textarea name="reason-$link->{ID}" wrap="off" rows=5 cols=40>$reason</textarea>
                </td>
            </tr>
        </table>
    </td></tr>
</table>
<br>
        ~;
    }
    my $toolbar;
    if ($total > $mh) {
        $toolbar = $html->toolbar($nh, $mh, $total, GT::CGI->url);
    }
    return { output => $output, results => $results, total => $total, toolbar => $toolbar };
}

sub validate_reviews {
# ------------------------------------------------------------------
# Display a list of reviews waiting to be validated. 
#
    my $db       = $DB->table ('Reviews');
    my $user_db  = $DB->table ('Users');
    my $link_db  = $DB->table ('Links');
    my $html     = $DB->html ( $db, $IN );
    my $font     = 'font face="Tahoma,Arial,Helvetica" size="2"';
    my $nh       = $IN->param('nh') || 1;
    my $mh       = $IN->param('mh') || 5;

# Process any actions.
    my $results  = _validate_review ($db);

# Clear our cgi so we don't cause conflicts.
    $html->{input} = {};

# Get a list of links awaiting validation.
    my $sth   = $db->query_sth ( { 
                                    Review_Validated => 'No', 
                                    mh => $mh, 
                                    nh => $nh,
                                    sb => 'Review_Date',
                                    so => 'DESC'
                            });
    my $total = $db->hits;
    my $i     = 0;

    my $output = '';
    while (my $review = $sth->fetchrow_hashref) {
        $i++;
        my $form = $html->form ( { values => $review, extra_table => 0, mode => 'validate', view_key => 1, multiple => $i, file_field => 1, file_delete => 1 } );

# Format the date 
        Links::init_date();
        $review->{Review_Date} = GT::Date::date_transform($review->{Review_Date},'%yyyy%-%mm%-%dd%',$CFG->{date_user_format});

# Load reason.
        my $user   = $user_db->get($review->{Review_Owner});
        my $link   = $link_db->get($review->{Review_LinkID});
        @{$user}{keys %$review} = (values %$review);
        @{$user}{keys %$link} = (values %$link);

        my $reason = Links::user_page ('review-email-del.txt', $user);
        $output .= qq~
<table border=1 cellpadding=0 cellspacing=0 width=500>
    <tr><td>$form</td></tr>
    <tr><td>
        <table border=0 cellpadding=3 cellspacing=2>
            <tr><td valign=top rowspan=2><$font><input type="radio" name="validate-$review->{ReviewID}" value="validate"> 
                                Validate<br><font size=1>
                                            </font>
                    </font>
                </td>
                <td valign=top><$font><input type="radio" name="validate-$review->{ReviewID}" value="delete">
                                Delete without reason.
                    </font>
                </td>
                <td valign=top><$font><input type="radio" name="validate-$review->{ReviewID}" value="email">
                                Delete and email reason.
                    </font>
                </td>
            </tr>
            <tr>
                <td colspan=2>
                    <textarea name="reason-$review->{ReviewID}" rows=5  wrap="off" cols=40>$reason</textarea>
                </td>
            </tr>
        </table>
    </td></tr>
</table>
<br>
        ~;
    }
    my $toolbar;
    if ($total > $mh) {
        $toolbar = $html->toolbar($nh, $mh, $total, GT::CGI->url);
    }
    return { output => $output, results => $results, total => $total, toolbar => $toolbar };
}

sub _validate_review {
# -------------------------------------------------------------------
# Validate/delete/email review.
#
    my $db = shift;

# Let's parse out the form, and group our reviews together.
    my $args = $IN->get_hash();
    my (@validate, @email, @delete, @modify, $tmp);
    while (my ($key, $param) = each %$args) {
        CASE: {
            ($key =~ /^validate-(\d+)/) and do { 
                                                push @validate, $1 if ($param eq 'validate');
                                                push @email,    $1 if ($param eq 'email');
                                                push @delete,   $1 if ($param eq 'delete');
                                                last CASE;
                                            };
            ($key =~ /^(\d+)-(.*)$/)     and do {
                                                $tmp->{$1}->{$2} = $param;
                                                last CASE;
                                            };
        };
    }
    my $review = {};
    foreach (keys %$tmp) {
        $review->{$tmp->{$_}->{ReviewID}} = $tmp->{$_};
    }
    unless (@validate or @email or @delete ) {
        return;
    }

# Now validate everyone.
    my %error;
    foreach my $id (@validate) {
        my $res = GT::Plugins->dispatch ($CFG->{admin_root_path} . '/Plugins', 'validate_link', \&_validate_review_record, $review->{$id});
        if ($res) { $error{$id} = $res; }
    }

# Delete records.
    foreach my $id (@delete) {
        my $results = $db->delete ( { ReviewID => $id } ) or ($error{$id} = "<li>$id (Couldn't delete: $GT::SQL::error)");
    }

# Delete and email records.
    foreach my $id (@email) {
        my $res = _delete_email_review_record ($review->{$id}, $IN->param("reason-$id"));
        if ($res) { $error{$id} = $res; };
    }

    my $results = join "", values %error;
    $results ? 
        ($results = "<font color=red><ul>$results</ul></font>") :
        ($results = "<font color=green>All Reviews successfully validated/deleted.</font>");
    return $results;
}

sub _validate_review_record {
# -------------------------------------------------------------------
# Validates a record.
#
    my $review = shift;

# Update the database.
    my $db   = $DB->table ('Reviews');
    $review->{Review_Validated} = 'Yes';

    $db->modify ( $review ) or return Links::language('VAL_GENERAL', $review->{ID}, $GT::SQL::error);    

# Add the link info to the fields.
    my $link   = $DB->table('Links')->get($review->{Review_LinkID});
    foreach my $key (keys %$link) {
        exists $review->{$key} or $review->{$key} = $link->{$key};
    }

# Add the user info to the fields.
    my $user_db   = $DB->table ('Users');
    my $user_info = $user_db->get ($review->{Review_Owner});
    foreach (keys %$user_info) { 
        $review->{$_} = $user_info->{$_} unless (exists $review->{$_}); 
    }

# Format the date 
    Links::init_date();
    $review->{Review_Date} = GT::Date::date_transform($review->{Review_Date},'%yyyy%-%mm%-%dd%',$CFG->{date_user_format});

# Add anonymous reviewer
    $review->{anonymous} = !$CFG->{user_review_required};
    my $email     = $review->{Review_GuestEmail} || $review->{Email};
    if (! $email or ($email !~ /^.+\@.+\..+$/)) {
        return Links::language('VAL_CANTEMAIL');
    }

# Send validation email.
    if ($CFG->{email_add}) {
        my $mail =  Links::user_page ('review-email-add.txt', $review) ;
        require GT::Mail;
        GT::Mail->send (
                            to       => $email,
                            from     => $CFG->{db_admin_email},
                            subject  => Links::language('REVIEW_VAL_APPROVESUB') || 'Your review has been approved.',
                            msg      => $mail || '',
                            smtp     => $CFG->{db_smtp_server},
                            sendmail => $CFG->{db_mail_path},
                            debug    => $reviews::DEBUG
                        ) or return Links::language ('VAL_CANTEMAIL', $GT::Mail::error);
    }
    return;
}

sub _delete_email_review_record {
# -------------------------------------------------------------------
# Delete and email a record.
#
    my ( $review, $reason) = @_;
    my $db      = $DB->table ('Reviews');
    my $user_db = $DB->table ('Users');

# Get the email address first.
    
    my $user_info = $user_db->get ($review->{Review_Owner});

# Delete the record.
    my $res = $db-> delete ( { ReviewID => $review->{ReviewID} } ) ;

    foreach (keys %$user_info) { $review->{$_} = $user_info->{$_} unless (exists $review->{$_}); }
    my $email     = $review->{Review_GuestEmail} || $review->{Email};
    if (! defined $email or ($email !~ /^.+\@.+\..+$/)) {
        return Links::language('VAL_CANTEMAIL');
    }

# Setup and send mail
    require GT::Mail;
    GT::Mail->send (
                        to          => $email,
                        from        => $CFG->{db_admin_email},
                        subject     => Links::language('VAL_REJECTSUB') || 'Your review has been rejected.',
                        msg         => $reason,
                        smtp        => $CFG->{db_smtp_server},
                        sendmail    => $CFG->{db_mail_path},
                        debug       => $Links::DEBUG
                    ) or return Links::language ('VAL_CANTEMAIL', $GT::Mail::error);
    return ;
}

sub _validate {
# -------------------------------------------------------------------
# Validate/delete/email and links.
#
    my $db = shift;

# Let's parse out the form, and group our links together.
    my $args = $IN->get_hash();
    my (@validate, @email, @delete, @modify, @delete_change, @email_change, $tmp);
    while (my ($key, $param) = each %$args) {
        CASE: {
            ($key =~ /^validate-(\d+)/) and do { 
                                                push @validate, $1 if ($param eq 'validate');
                                                push @email,    $1 if ($param eq 'email');
                                                push @delete,   $1 if ($param eq 'delete');
                                                push @modify,   $1 if ($param eq 'modify');
                                                push @delete_change, $1 if ($param eq 'deletechange');
                                                push @email_change,  $1 if ($param eq 'emailchange');
                                                last CASE;
                                            };
            ($key =~ /^(\d+)-(.*)$/)     and do {
                                                $tmp->{$1}->{$2} = $param;
                                                last CASE;
                                            };
        };
    }
    my $links = {};
    foreach (keys %$tmp) {
        $links->{$tmp->{$_}->{ID}} = $tmp->{$_};
    }
    unless (@validate or @email or @delete or @modify or @delete_change or @email_change) {
        return;
    }

# Now validate everyone.
    my $email_db = $DB->table('Users');
    my $chng_db  = $DB->table('Changes');
    my %error;
    foreach my $id (@validate) {
        $links->{$id}->{_mode} = 'validate';
        my $res = GT::Plugins->dispatch ($CFG->{admin_root_path} . '/Plugins', 'validate_link', \&_validate_record, $links->{$id});
        if ($res) { $error{$id} = $res; }
    }

# Now modify everyone.
    foreach my $id (@modify) {
        $links->{$id}->{_mode} = 'modify';
        my $res = GT::Plugins->dispatch ($CFG->{admin_root_path} . '/Plugins', 'validate_link', \&_validate_record, $links->{$id});
        if ($res) { 
            $error{$id} = $res; 
        }
        else { 
            $chng_db->delete ( { LinkID => $id }); 
        }
    }

# Delete records.
    foreach my $id (@delete) {
        my $results = _delete_record ($db, $id);
        $results or ($error{$id} = "<li>$id (Couldn't delete: $GT::SQL::error)");
    }

# mods on Jan 13, 2002
    foreach my $id (@email) {
        $links->{$id}->{_mode} = 'validate';
        my $res = &_validate_record_new($links->{$id}, $IN->param("reason-$id"));
        if ($res) { $error{$id} = $res; };
    }
# mod ends 

# Delete change requests
    foreach my $id (@delete_change) {
        my $results = _delete_change ($id);
        $results or ($error{$id} = "<li>$id (Couldn't delete: $GT::SQL::error)");
    }

# mods on Jan 13, 2002
    foreach my $id (@email_change) {
		# mod
        $links->{$id}->{_mode} = 'modify';
        my $res = &_validate_record_new($links->{$id}, $IN->param("reason-$id"));
        #my $res = _delete_email_change_record ($db, $email_db, $links->{$id}, $IN->param("reason-$id"));
        if ($res) { $error{$id} = $res; }
    }
# mod ends 

    my $results = join "", values %error;
    $results ? 
        ($results = "<font color=red><ul>$results</ul></font>") :
        ($results = "<font color=green>All Links successfully validated/deleted.</font>");
    return $results;
}

sub _validate_record {
# -------------------------------------------------------------------
# Validates a record.
#
    my $link = shift;

# Update the database.
    my $type = $link->{_mode};
    my $db   = $DB->table ('Links');
    delete $link->{Timestmp} if ($type eq 'modify');
    $link->{isValidated} = 'Yes';

# Check the paths
    my %fcols = $db->_file_cols();
    for ( keys %fcols ) {
        require GT::SQL::File;
        my $path = $link->{$_."_path"} or next;
        $path =~ m,^$CFG->{admin_root_path}/tmp, or next;
        $link->{$_} = GT::SQL::File->open($path);
    }

    $db->modify ( $link ) or return Links::language('VAL_GENERAL', $link->{ID}, $GT::SQL::error);

    for ( keys %fcols ) { $link->{$_."_path"} =~ m,^$CFG->{admin_root_path}/tmp/, and _file_path_ok($link->{$_."_path"}) and unlink $link->{$_."_path"}; };

# Add the user info to the fields.
    my $user_db   = $DB->table ('Users');
    my $user_info = $user_db->get ($link->{LinkOwner}) || {};
    foreach (keys %$user_info) { $link->{$_} = $user_info->{$_} unless (exists $link->{$_}); }
    my $email     = $link->{Contact_Email} || $link->{Email};

    if (! $email or ($email !~ /^.+\@.+\..+$/)) {
        return Links::language('VAL_CANTEMAIL');
    }

# Setup category tag, and Contact_Email, Contact_Name.
    $link->{Category}      = join "\n", values %{$db->get_categories ($link->{ID})};

# Send validation email.
    if (($type eq 'validate' and $CFG->{email_add}) or ($type eq 'modify' and $CFG->{email_mod})) {
        my $mail = ($type eq 'validate') ? Links::user_page ('email-add.txt', $link) : Links::user_page ('email-mod.txt', $link);
        require GT::Mail;
        GT::Mail->send (
                            to       => $email,
                            from     => $CFG->{db_admin_email} || '',
                            subject  => ($type eq 'validate') ? Links::language('VAL_APPROVESUB') : Links::language('VAL_APPROVECHGSUB'),
                            msg      => $mail || '',
                            smtp     => $CFG->{db_smtp_server},
                            sendmail => $CFG->{db_mail_path},
                            debug    => $Links::DEBUG
                        ) or return Links::language ('VAL_CANTEMAIL', $GT::Mail::error);
    }
    return;
}

sub _delete_email_record {
# -------------------------------------------------------------------
# Delete and email a record.
#
    my ($db, $email_db, $link, $reason) = @_;

# Get the email address first.
    my $email = $email_db->get ($link->{LinkOwner}, 'HASH') || {};

# Delete the record.
    _delete_record ($db, $link->{ID}) or return $GT::SQL::error;

# Mail the user.    
    foreach (keys %$email) { $link->{$_} = $email->{$_} unless (exists $link->{$_}); }

# Setup category tag, and Contact_Email, Contact_Name.
    $link->{Category}       = join "\n", values %{$db->get_categories ($link->{ID})};
    my $email_to = $link->{Contact_Email} || $link->{Email};
    if (! defined $email_to or ($email_to !~ /^.+\@.+\..+$/)) {
        return Links::language('VAL_CANTEMAIL');
    }

    my $mail = Links::user_page ('email-del.txt', $link);
    require GT::Mail;
    GT::Mail->send (
                        to          => $email_to,
                        from        => $CFG->{db_admin_email},
                        subject     => Links::language('VAL_REJECTSUB') || 'Your link has been rejected.',
                        msg         => $reason,
                        smtp        => $CFG->{db_smtp_server},
                        sendmail    => $CFG->{db_mail_path},
                        debug       => $Links::DEBUG
                    ) or return Links::language ('VAL_CANTEMAIL', $GT::Mail::error);
    return;
}

sub _delete_email_change_record {
# -------------------------------------------------------------------
# Delete and email a change request.
#
    my ($db, $email_db, $link, $reason) = @_;

# Get the email address first.
    my $email = $email_db->get ($link->{LinkOwner}, 'HASH') || {};

# Delete the record.
    _delete_change ($link->{ID}) or return $GT::SQL::error;

# Mail the user.    
    foreach (keys %$email) { $link->{$_} = $email->{$_} unless (exists $link->{$_}); }
    if (! defined $link->{Email} or ($link->{Email} !~ /^.+\@.+\..+$/)) {
        return Links::language('MODIFY_CANTEMAIL');
    }

# Setup category tag, and Contact_Email, Contact_Name.
    $link->{Category}       = join "\n", values %{$db->get_categories ($link->{ID})};
    $link->{Contact_Email}  = $link->{'Contact Email'} = $link->{Email};
    $link->{Contact_Name}   = $link->{'Contact Name'}  = $link->{Name} || $link->{Username} || '';

    my $mail = Links::user_page ('email-del.txt', $link);
    require GT::Mail;
    GT::Mail->send (
                        to => $link->{Email},
                        from => $CFG->{db_admin_email},
                        subject => Links::language('MODIFY_REJECTSUB') || 'Your change has been rejected.',
                        msg => $reason,
                        smtp => $CFG->{db_smtp_server},
                        sendmail => $CFG->{db_mail_path},
                        debug => $Links::DEBUG
                    ) or return Links::language ('MODIFY_CANTEMAIL', $GT::Mail::error);
    return;
}

sub _delete_record {
# -------------------------------------------------------------------
# Deletes a link waiting to be validated, and the user that submitted it.
#
    my ($db, $id) = @_;
    my $link = $db->get ($id, 'HASH', ['LinkOwner']);
    $db->delete ( { ID => $id } ) or return Links::language('VAL_GENERAL', $id, $GT::SQL::error);

# Remove the user if that's their only record and they were auto-setup.
    if ($link) {
        my $records = $db->count ( { LinkOwner => $link->{LinkOwner}, Status => 'Not Validated' });
        if (! $records) {
            my $user_db = $DB->table ('Users');
            $user_db->delete ( { Username => $link->{LinkOwner}, Status => 'Not Validated' });
        }
    }
    return 1;
}

sub _delete_change {
# -------------------------------------------------------------------
# Deletes a link waiting to be validated, and the user that submitted it.
#
    my $id = shift;
    my $db = $DB->table('Changes');
    my %fcols = $DB->table('Links')->_file_cols();
    my $href = $db->get( { LinkID => $id } ) || {};  
    $href = eval $href->{ChgRequest};
    
    for ( keys %fcols ) { 
        my $fpath = $href->{$_};
        $fpath =~ m,^$CFG->{admin_root_path}/tmp/, and _file_path_ok($fpath) and unlink $fpath;
    };
    $db->delete ( { LinkID => $id } );

    return 1;
}

sub _file_path_ok {
# -------------------------------------------------------------------
    my $fpath = shift;
    return (
                ( $fpath !~ /\.\./) and
                ( $fpath =~ /^[\w\\\/\-\.%]+$/) and
                ( -e $fpath ) and
                ( $fpath =~ m,^$CFG->{admin_root_path}/tmp/,) 
            );
}

sub quick_links {
# -------------------------------------------------------------------
# Add quick links to the admin menu.
#
    my $name   = $IN->param('name');
    my $url    = $IN->param('url');
    my $manage = $IN->param('manage') || '';
    my @to_delete = $IN->param('remove');
    if ($IN->param('delete')) {
        foreach my $url (@to_delete) {
            delete $CFG->{quick_links}->{$url};
        }
        $CFG->save;
    }

    if ($name and $url) {
        $CFG->{quick_links}->{$url} = $name;
        $CFG->save;
    }
    my $output;
    foreach my $url (sort { $CFG->{quick_links}->{$a} cmp $CFG->{quick_links}->{$b} } keys %{$CFG->{quick_links}}) {
        $output .= qq~<input type="checkbox" name="remove" value="$url"> ~ if ($manage);
        $output .= qq~&nbsp; <a href="$url">$CFG->{quick_links}->{$url}</a><br>~;
    }
    return { quick_links => $output }
}

sub sql_monitor {
# -------------------------------------------------------------------
# Run's queries.
#
    my $query = $IN->param('query') or return {};
    my $file  = $IN->param('saveto');
    my $table = $DB->table('Links');

 # demo    
 # return { error => "SQL Monitor is disabled in the demo." }; 

    my ($sth, $rv, $output);

    $sth = $table->prepare ($query) or return { error => "Query Error: $GT::SQL::error" };
    $rv  = $sth->execute() or return { error => "Query Error: $GT::SQL::error" };

    my $rows = $sth->rows || 0;
    $file and (open (FILE, ">$file") or return { error => "Unable to open file: '$file'. Reason: $!" });
    if ($query =~ /^\s*(SELECT|DESCRIBE|SHOW|sp_)/i) {
        $output = "<pre>Your query returned $rows rows. \n\n";
        while (my $arr = $sth->fetchrow_arrayref) {
            $file ? (print FILE join ("\t", @$arr), "\n") : ($output .= join ("\t", @$arr) . "\n");
        }
        $output .= "</pre>";
    }
    else {
        $output = "Rows affected: $rows";
    }
    return { results => $output };
}

sub remote_user {
# -------------------------------------------------------------------
# Returns a remote_user environment variable.
#
    my $user = $ENV{REMOTE_USER} or return '';
    $user eq '-' and return ''; # xitami sets it to '-', ugh.
    return $user;
}

sub auth_users {
# -------------------------------------------------------------------
# Shows a list of users in the .htpasswd file.
#
    my $htpasswd = $CFG->{admin_root_path} . "/.htpasswd";

    open (HTPAS, "< $htpasswd") or die "Unable to open: $htpasswd ($!)";
    my @users = <HTPAS>;
    close HTPAS;
    my $delete_list = '<select name="delete_user"><option>' . join ("<option>", map { /^([^:]+)/ ? $1 : '' } @users) . '</select>' if (@users);
    return { delete_list => $delete_list };
}


# ------------------------------------------
# mods on Jan 13, 2002

sub _validate_record_new {
# -------------------------------------------------------------------
# Validates a record.
#
    my $link = shift;

	my $mail = shift;

# Update the database.
    my $type = $link->{_mode};
    my $db   = $DB->table ('Links');
    delete $link->{Timestmp} if ($type eq 'modify');
    $link->{isValidated} = 'Yes';

# Check the paths
    my %fcols = $db->_file_cols();
    for ( keys %fcols ) {
        require GT::SQL::File;
        my $path = $link->{$_."_path"} or next;
        $path =~ m,^$CFG->{admin_root_path}/tmp, or next;
        $link->{$_} = GT::SQL::File->open($path);
    }

    $db->modify ( $link ) or return Links::language('VAL_GENERAL', $link->{ID}, $GT::SQL::error);

    for ( keys %fcols ) { $link->{$_."_path"} =~ m,^$CFG->{admin_root_path}/tmp/, and _file_path_ok($link->{$_."_path"}) and unlink $link->{$_."_path"}; };

# Add the user info to the fields.
    my $user_db   = $DB->table ('Users');
    my $user_info = $user_db->get ($link->{LinkOwner}) || {};
    foreach (keys %$user_info) { $link->{$_} = $user_info->{$_} unless (exists $link->{$_}); }
    my $email     = $link->{Contact_Email} || $link->{Email};

    if (! $email or ($email !~ /^.+\@.+\..+$/)) {
        return Links::language('VAL_CANTEMAIL');
    }

# Setup category tag, and Contact_Email, Contact_Name.
    $link->{Category}      = join "\n", values %{$db->get_categories ($link->{ID})};

# Send validation email.
    if (1) { #(($type eq 'validate' and $CFG->{email_add}) or ($type eq 'modify' and $CFG->{email_mod})) {
        #my $mail = ($type eq 'validate') ? Links::user_page ('email-add.txt', $link) : Links::user_page ('email-mod.txt', $link);
        require GT::Mail;
        GT::Mail->send (
                            to       => $email,
                            from     => $CFG->{db_admin_email} || '',
                            subject  => ($type eq 'validate') ? Links::language('VAL_APPROVESUB') : # Links::language('VAL_APPROVECHGSUB'),

			    

                            msg      => $mail || '',
                            smtp     => $CFG->{db_smtp_server},
                            sendmail => $CFG->{db_mail_path},
                            debug    => $Links::DEBUG
                        ) or return Links::language ('VAL_CANTEMAIL', $GT::Mail::error);
    }
    return;
}

# mods ------------------------------------------


1;