# ==================================================================
# Gossamer Links - enhanced directory management system
#
#   Website  : http://gossamer-threads.com/
#   Support  : http://gossamer-threads.com/scripts/support/
#   CVS Info : 087,071,086,086,085 
#   Revision : $Id: Browser.pm,v 1.132 2013/02/13 01:01:34 brewt 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::Browser;
# ==================================================================
use strict;
use vars  qw/@ISA $ATTRIBS/;
use Links qw/:objects :payment/;
use GT::Base;
use Links::Browser::Controller;
use GT::AutoLoader;

@ISA     = qw/GT::Base/;
$ATTRIBS = {
    load_full => 200,
    ctrl      => undef,
};

# -------------------------------------------------------------------------------------- #
# Template parsing                                                                       #
# -------------------------------------------------------------------------------------- #
sub print_template {
# -------------------------------------------------------------------
# Prints out a template.
#
    if ($IN->param('d')) {
        print $_[0]->_template($_[1], $_[2], { print => 0, dynamic => 1 });
    }
    else {
        $_[0]->_template($_[1], $_[2], { print => 1 });
    }
}

sub return_template {
# -------------------------------------------------------------------
# Returns a template.
#
    $_[0]->_template($_[1], $_[2], { print => 0 });
}

sub _template {
# -------------------------------------------------------------------
# Prints/Returns a template.
#
    my ($self, $tpl, $vars, $opts) = @_;
    $vars->{enctype} = ($DB->table('Category')->_file_cols or $DB->table('Links')->_file_cols) ? ' enctype="multipart/form-data" ' : '';
    $vars->{is_admin} = $self->{ctrl}->{admin_templates} ? 1 : 0;

    if ($self->{ctrl}->{admin_templates}) {
        Links->admin_page($tpl, $vars, $opts);
    }
    else {
        Links->user_page($tpl, $vars, $opts);
    }
}

# -------------------------------------------------------------------------------------- #
# Window Initilization Functions                                                         #
# -------------------------------------------------------------------------------------- #
$COMPILE{main_panel_init} = __LINE__ . <<'END_OF_SUB';
sub main_panel_init {
# -------------------------------------------------------------------
# $obj->main_panel_init();
# ------------------------
#   Prints the HTML / Javascript that goes in the top-level
#   HTML page that controls the whole Javascript.
#
    my $self = shift;
    my $base = $self->{ctrl}->user_base_node;
    my $rooted = @$base ? 1 : 0;
    my $owner_links = $DB->table('Links')->count({LinkOwner => $USER->{Username}});
    my ($root_name, $root_id);
    $self->print_template ('browser.html', {
                                   id => 0,
                                   fatherid => 0,
                                   name => Links::language('LINKS_TOP'),
                                   nb_links => "null",
                                   max_load_full => $self->{load_full},
                                   total_categories => $self->_total_categories,
                                   is_rooted => $rooted,
                                   owner_links => $owner_links,
                                  } );
    return 1;
}
END_OF_SUB

$COMPILE{tree_panel_init} = __LINE__ . <<'END_OF_SUB';
sub tree_panel_init {
# -------------------------------------------------------------------
# $obj->tree_panel_init();
# ------------------------
#   Prints the HTML / Javascript that goes in the left
#   HTML page in order to initialize the Javascript tree
#   and draw it.
#
    my $self = shift;
    $self->print_template ('browser_tree.html', {});
}
END_OF_SUB

$COMPILE{info_panel_init} = __LINE__ . <<'END_OF_SUB';
sub info_panel_init {
# -------------------------------------------------------------------
# $obj->_init();
# ------------------------
#  Prints the HTML that goes in the info panel when
#  it is initialized. This normally should be a tutorial
#  on how to use the category browser.
#
    my $self = shift;
    $self->print_template ('browser_info.html', {});
}
END_OF_SUB

$COMPILE{code_panel_init} = __LINE__ . <<'END_OF_SUB';
sub code_panel_init {
# -------------------------------------------------------------------
# $obj->code_panel_init();
# ------------------------
#  Prints the HTML / Javascript that will update
#  the tree with basic information.
#
#  if the CGI param or the Controller variable load_tree
#  is true, then the whole tree is sent to the client,
#  avoiding future updates.
#
    my $self = shift;
    if (($IN->param('load_tree') or $self->{ctrl}->{load_tree}) and ($self->{load_full} > $self->_total_categories())) {
        return $self->code_panel_reload_full (@_);
    }
    $self->print_template ('browser_code_init.html', { instructions => $self->code_panel_init_loop () });
}
END_OF_SUB

# -------------------------------------------------------------------------------------- #
# Javascript Tree Management Functions                                                   #
# -------------------------------------------------------------------------------------- #

$COMPILE{code_panel_init_loop} = __LINE__ . <<'END_OF_SUB';
sub code_panel_init_loop {
# -------------------------------------------------------------------
# $obj->code_panel_init_loop();
# -----------------------------
#   Builds a bunch of "tree.addNode ( new LoadedNode ( $cat_id, $father_id, "$name" ) );"
#   javascript commands that will be used to initialize the tree's values.
#
    my $self        = shift;
    my $base        = $self->{ctrl}->user_base_node;
    my $category    = $DB->table ("Category");
    my (@res, $sth, $set_root);

    if (@$base) {
        my $roots = '(' . join (",", @$base) . ')';
        $category->select_options ('ORDER BY Name ASC');
        $sth = $category->select ( GT::SQL::Condition->new('ID', 'IN', \$roots), ['ID', 'FatherID', 'Name', 'Number_of_Links'] )
                            or die "Database Error: $GT::SQL::error";
        $set_root = 1;
    }
    else {
        $category->select_options ('ORDER BY Name ASC');
        $sth = $category->select ( { FatherID => 0 }, ['ID', 'FatherID', 'Name', 'Number_of_Links'] )
                            or die "Database Error: $GT::SQL::error";
    }
    while (my $h = $sth->fetchrow_hashref) {
        $h->{FatherID} = $set_root ? 0 : $h->{FatherID};
        if ($self->code_panel_init_loop_is_leaf ($category, $h->{ID})) {
            push @res, qq~parent.tree.addNode ( new parent.LoadedNode ( $h->{ID}, $h->{FatherID}, ~ . _quote($h->{Name}) . qq~, $h->{Number_of_Links} ) );\n~;
        }
        else {
            push @res, qq~parent.tree.addNode ( new parent.UnloadedNode ( $h->{ID}, $h->{FatherID}, ~ . _quote($h->{Name}) . qq~, $h->{Number_of_Links} ) );\n~;
        }
    }
    return join '', ("\n", @res);
}
END_OF_SUB

$COMPILE{code_panel_init_loop_is_leaf} = __LINE__ . <<'END_OF_SUB';
sub code_panel_init_loop_is_leaf {
# -------------------------------------------------------------------
# $obj->code_panel_init_loop_is_leaf ($id);
# -----------------------------------------
#   Returns TRUE if the category which id is $id has no
#   childs, FALSE otherwise.
#
    my ($self, $category, $cat_id) = @_;
    my $sth = $category->select ( { FatherID => $cat_id }, ['ID'] ) or die "Database Error: $GT::SQL::error";
    return $sth->fetchrow_arrayref ? 0 : 1;
}
END_OF_SUB

$COMPILE{code_panel_category_expand} = __LINE__ . <<'END_OF_SUB';
sub code_panel_category_expand {
# -------------------------------------------------------------------
# $obj->code_panel_category_expand;
# ---------------------------------
#   Returns the HTML that updates and redraws the tree
#   when an user clicks on an unloaded node.
#
    my $self         = shift;
    my $category_id  = $IN->param ('category_id');
    my @res          = ();
    my $category     = $DB->table ('Category');
    $category->select_options ('ORDER BY Name ASC');
    my $sth          = $category->select ( { FatherID => $category_id }, ['ID', 'FatherID', 'Name', 'Number_of_Links'] );

    while (my $h = $sth->fetchrow_hashref) {
        if ( $self->code_panel_init_loop_is_leaf ($category, $h->{ID}) ) {
            push @res, qq~parent.tree.addNode ( new parent.LoadedNode ( $h->{ID}, $h->{FatherID}, ~ . _quote($h->{Name}) . qq~, $h->{Number_of_Links} ) );\n~;
        }
        else {
            push @res, qq~parent.tree.addNode ( new parent.UnloadedNode ( $h->{ID}, $h->{FatherID}, ~ . _quote($h->{Name}) . qq~, $h->{Number_of_Links} ) );\n~;
        }
    }
    my $instructions =  join '', ("\n", @res);
    return $self->print_template('browser_category_expand.html', { instructions => $instructions, category_id => $category_id });
}
END_OF_SUB

$COMPILE{code_panel_reload_empty} = __LINE__ . <<'END_OF_SUB';
sub code_panel_reload_empty {
# -------------------------------------------------------------------
# $obj->code_panel_reload_empty ($id);
# ------------------------------------
#   Reinitialize the tree for an empty tree.
#
    my $self = shift;
    $self->print_template ('browser_code_init.html', { instructions => $self->code_panel_init_loop () } );
}
END_OF_SUB

$COMPILE{code_panel_reload_full} = __LINE__ . <<'END_OF_SUB';
sub code_panel_reload_full {
# -------------------------------------------------------------------
# $obj->code_panel_reload_full ($id);
# -----------------------------------
#   Reinitializes the tree, but loading all info.
#
    my $self        = shift;
    my $base        = $self->{ctrl}->user_base_node;
    my $category    = $DB->table ("Category");
    my (@res, $sth, $set_root);

    if (@$base) {
        foreach my $node (@$base) {
            my $rows  = 0;
            my $cat_r = $category->get ($node, 'HASH', ['ID', 'FatherID', 'Name', 'Full_Name', 'Number_of_Links']) or next;
            my $str   = $cat_r->{Full_Name} . '/%';
            $category->select_options ('ORDER BY Full_Name ASC');
            $sth = $category->select ( GT::SQL::Condition->new('Full_Name', 'LIKE', $str), ['ID', 'FatherID', 'Name', 'Number_of_Links'] );
            while (my $h = $sth->fetchrow_hashref) {
                if ( $self->code_panel_init_loop_is_leaf ($category, $h->{ID}) ) {
                    push @res, qq~parent.tree.addNode ( new parent.LoadedNode ( $h->{ID}, $h->{FatherID}, ~ . _quote($h->{Name}) . qq~, $h->{Number_of_Links} ) );~;
                }
                else {
                    push @res, qq~parent.tree.addNode ( new parent.UnloadedNode ( $h->{ID}, $h->{FatherID}, ~ . _quote($h->{Name}) . qq~, $h->{Number_of_Links} ) );~;
                }
                $rows++;
            }
            if ($rows) {
                unshift @res, qq~parent.tree.addNode ( new parent.UnloadedNode ( $cat_r->{ID}, 0, ~ . _quote($cat_r->{Name}) . qq~, $cat_r->{Number_of_Links} ) );~;
            }
            else {
                unshift @res, qq~parent.tree.addNode ( new parent.LoadedNode ( $cat_r->{ID}, 0, ~ . _quote($cat_r->{Name}) . qq~, $cat_r->{Number_of_Links} ) );~;
            }
        }
    }
    else {
        $category->select_options ('ORDER BY Full_Name ASC');
        $sth = $category->select ( ['ID', 'FatherID', 'Name', 'Number_of_Links'] );

        while (my $h = $sth->fetchrow_hashref) {
            if ( $self->code_panel_init_loop_is_leaf ($category, $h->{ID}) ) {
                push @res, qq~parent.tree.addNode ( new parent.LoadedNode ( $h->{ID}, $h->{FatherID}, ~ . _quote($h->{Name}) . qq~, $h->{Number_of_Links} ) );~;
            }
            else {
                push @res, qq~parent.tree.addNode ( new parent.UnloadedNode ( $h->{ID}, $h->{FatherID}, ~ . _quote($h->{Name}) . qq~, $h->{Number_of_Links} ) );~;
            }
        }
    }
    my $instructions = join "", @res;
    $self->print_template ('browser_code_init.html', { instructions => $instructions } );
}
END_OF_SUB

$COMPILE{category_click} = __LINE__ . <<'END_OF_SUB';
sub category_click {
# -------------------------------------------------------------------
# $obj->category_click;
# --------------------------------
#   This function is invoked by the Javascript tree
# whenever the user clicks on a category.
#
    my $self        = shift;
    my $category_id = $IN->param ('category_id');
    my $category    = $DB->table ("Category");
    if ($category_id == 0) {
        my $navbar = $self->navbar ($category_id);
        $self->print_template ( "browser_category.html", { navbar => $navbar, Name => Links::language('LINKS_TOP'), links => '' } );
    }
    else {
        my $sth    = $category->select ( { ID => $category_id }, ['ID', 'Name', 'Number_of_Links'] )
                            or die "Database Error: $GT::SQL::error";
        my $info   = $sth->fetchrow_hashref or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDCATID', $category_id) );
        my $navbar = $self->navbar ($category_id);
        my %info   = $self->_links_list_html ($category_id);
        $self->print_template ( "browser_category.html",
                                {
                                    navbar => $navbar,
                                    Name   => $info->{Name},
                                    %info
                                });
    }
}
END_OF_SUB

# -------------------------------------------------------------------------------------- #
# CATEGORY Management Functions                                                          #
# -------------------------------------------------------------------------------------- #

$COMPILE{category_add_form} = __LINE__ . <<'END_OF_SUB';
sub category_add_form {
# -------------------------------------------------------------------
# $obj->category_add_form;
# -----------------------------------
#   Displays a form that lets the user enter a new sub-category.
#
    my $self        = shift;
    my $category_id = $IN->param ('category_id');
    my $category    = $DB->table ('Category');
    my ($info, $name);

    if ($category_id)
    {
        my $sth  = $category->select ( { ID => $category_id }, ['ID', 'Name', 'Number_of_Links'] );
        my $info = $sth->fetchrow_hashref or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDCATID', $category_id) );
        $name    = $info->{Name};
    }
    else { $name = Links::language('LINKS_TOP') }

    # --- -- - ADD CATEGORY FORM CONSTRUCTION - -- --- #
    my $h  = $DB->html($category, {
        FatherID          => $category_id,
        Has_New_Links     => "No",
        Has_Changed_Links => "No",
        Number_of_Links   => 0,
        Direct_Links      => 0
    });
    my $navbar = $self->navbar($category_id);
    my @hide = qw/FatherID Full_Name Number_of_Links Direct_Links Has_New_Links Has_Changed_Links Newest_Link/;
    push @hide, qw/Payment_Mode Payment_Description/ unless $CFG->{payment}->{enabled};
    $self->print_template("browser_category_add_form.html",
                               {
                                navbar => $navbar,
                                Name   => $name,
                                form   => $h->form (
                                                    {
                                                     skip => [ qw/ID Timestmp/ ],
                                                     hide => [ @hide ],
                                                     file_field => 1, file_delete => 1,
                                                     defaults => 1,
                                                     code => { FatherID => undef }
                                                    }
                                                   )
                               }
                             );
}
END_OF_SUB

$COMPILE{category_add} = __LINE__ . <<'END_OF_SUB';
sub category_add {
# -------------------------------------------------------------------
# $obj->category_add;
# ------------------------------
#   Adds a category to the current working dir.
#   This function should do three things:
#
#   * Add the category in the database
#   * List all the links in the current category
#   * Update the javascript tree so that we keep
#     it synchronized with the database.
#
    my $self = shift;
    my $name = $IN->param('Name');
    my $category = $DB->table('Category');
    my $parent_category_id = $IN->param('FatherID') || 0;

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

    my $child_category_id = $category->add($IN->get_hash)
        or return $self->javascript_error( message => Links::language('BROWSER_CATCANTADD', _format_js($GT::SQL::error)), info_go => -1 );
    my $navbar = $self->navbar($parent_category_id);
    my $parent = $category->get( $parent_category_id, 'HASH', [ 'Name' ] );
    my %info   = $self->_links_list_html($parent_category_id);

    $self->print_template("browser_category_add.html",
                            {
                                    navbar          => $navbar,
                                    child_id        => $child_category_id,
                                    father_id       => $parent_category_id,
                                    child_name      => $name,
                                    parent_name     => $parent->{Name} || Links::language('LINKS_TOP'),
                                    %info
                            });
}
END_OF_SUB

$COMPILE{category_del_form} = __LINE__ . <<'END_OF_SUB';
sub category_del_form {
# -------------------------------------------------------------------
# $obj->category_del_form;
# -----------------------------------
#   This function prints a confirmation screen when
#   an user wants to delete a form.
#
    my $self        = shift;
    my $category_id = $IN->param ('category_id');
    my $category    = $DB->table ('Category');
    my $navbar = $self->navbar ($category_id);
    my $info        = $category->get ( { ID => $category_id }, 'HASH', ['ID', 'Name', 'Number_of_Links'] )
                            or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDCATID', $category_id), hist_go => -1);

    $self->print_template ( "browser_category_del_form.html",
                            {
                                category_id => $category_id,
                                navbar  => $navbar,
                                Name    => $info->{Name}
                           });
}
END_OF_SUB

$COMPILE{category_del} = __LINE__ . <<'END_OF_SUB';
sub category_del {
# -------------------------------------------------------------------
# $obj->category_del;
# ------------------------------
#   Prints in the info pane a frame that updates the
#   javascript tree on the left and displays the category
#   which is the father of the category that has been
#   deleted.
#
    my $self        = shift;
    my $category_id = $IN->param ('category_id');
    my $category    = $DB->table ('Category');


    my $info        = $category->get ( { ID => $category_id }, 'HASH', ['ID', 'Name', 'Number_of_Links', 'FatherID'] )
                        or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDCATID', $category_id), info_go => -1 );
    my $child_name  = $info->{Name};
    my $father_id   = $info->{FatherID};
    $category->delete ( { ID => $category_id } )
                        or return $self->javascript_error ( message => Links::language('BROWSER_CATCANTDEL', _format_js ($GT::SQL::error)), info_go => -1 );

    my ($father_name);
    if ($father_id == 0) {
        $father_name = Links::language('LINKS_TOP')
    }
    else {
        $info = $category->get ( { ID => $father_id }, 'HASH', ['Name'] )
                        or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDCATID', $father_id) );
        $father_name = $info->{Name};
    }

    my $navbar = $self->navbar ($father_id);
    my %info   = $self->_links_list_html ($father_id);
    $self->print_template ( "browser_category_del.html",
                               {
                                navbar      => $navbar,
                                father_id   => $father_id,
                                child_id    => $category_id,
                                father_name => $father_name,
                                child_name  => $child_name,
                                %info
                               } );
}
END_OF_SUB

$COMPILE{category_modify_form} = __LINE__ . <<'END_OF_SUB';
sub category_modify_form {
# -------------------------------------------------------------------
# $obj->category_modify_form;
# --------------------------------------
#   This function prints a modification form
#   for the requested category.
#
    my $self        = shift;
    my $category_id = $IN->param ('category_id');
    my $category    = $DB->table ('Category');
    my $info        = $category->get ( { ID => $category_id } ) or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDCATID', $category_id), hist_go => -1);
    my $navbar      = $self->navbar ($category_id);

    my @hide = qw/FatherID Full_Name Number_of_Links Direct_Links Has_New_Links Has_Changed_Links Newest_Link Timestmp/;
    push @hide, qw/Payment_Mode Payment_Description/ unless $CFG->{payment}->{enabled};

    my $h = $DB->html($category, $info);
    $self->print_template ( "browser_category_modify_form.html",
                               {
                                category_id => $category_id,
                                navbar      => $navbar,
                                Name        => $info->{Name},
                                form        => $h->form ( { hide => [ @hide ], view => ['ID'], file_field => 1, file_delete => 1, code => { FatherID => undef } })
                               } );
}
END_OF_SUB

$COMPILE{category_modify} = __LINE__ . <<'END_OF_SUB';
sub category_modify {
# -------------------------------------------------------------------
# $obj->category_modify;
# ---------------------------------
#   This method performs the modification operation
#   on the database and updates the javascript tree.
#
    my $self        = shift;
    my $category_id = $IN->param ("ID");
    my $name        = $IN->param ('Name');
    my $category    = $DB->table ('Category');
    my $navbar      = $self->navbar ($category_id);


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

    $category->modify ($IN->get_hash)
        or return $self->javascript_error ( message => Links::language('BROWSER_CANTMOD', _format_js ($GT::SQL::error)), hist_go => -1 );
    my %info = $self->_links_list_html ( $category_id);
    $self->print_template ( "browser_category_modify.html",
                               {
                                category_id => $category_id,
                                Name        => $name,
                                Name_quoted => _quote($name),
                                navbar      => $navbar,
                                %info
                               } );
}
END_OF_SUB

$COMPILE{category_move_form} = __LINE__ . <<'END_OF_SUB';
sub category_move_form {
# -------------------------------------------------------------------
# $obj->category_move_form;
# ------------------------------------
#   This function output a category move form when the
#   user clicks on the "move" link of the category he / she
#   is browsing.
#
#   This form should include a special javascript variable,
#   "move_from", that tells the tree that the user is moving
#   from a given category and not selecting a directory
#   whenever he wants to move a category.
#
    my $self        = shift;
    my $category_id = $IN->param ('category_id');
    my $category    = $DB->table ('Category');
    my $navbar      = $self->navbar ($category_id);
    my $info        = $category->get ( { ID => $category_id }, 'HASH', ['ID', 'Name', 'Number_of_Links'] )
                    or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDCATID'), hist_go => -1);

    $self->print_template ( "browser_category_move_form.html",
                               {
                                navbar      => $navbar,
                                Name        => $info->{Name},
                                category_id => $category_id
                               } );
}
END_OF_SUB

$COMPILE{category_move} = __LINE__ . <<'END_OF_SUB';
sub category_move {
# -------------------------------------------------------------------
# $obj->category_move;
# -------------------------------
#   Moves a category based on the user input (CGI
#   objects and others).
#
    my $self          = shift;
    my $category_from = $IN->param ("category_from");
    my $category_to   = $IN->param ("category_to");
    my $category      = $DB->table ('Category');


# get some information about the category that we're moving
    my $info_from = $category->get ( { ID => $category_from } )
                        or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDCATID', $category_from) );
    my $old       = $info_from->{FatherID};

# get some information about the category where we want to move to,
    my $info_to;
    if ($category_to) {
        $info_to = $category->get ( { ID => $category_to }, 'HASH', ['ID', 'FatherID', 'Full_Name', 'Name', 'Number_of_Links'])
                        or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDCAT', $category_to) );
    }
    else {
        $info_to = { ID => 0, FatherID => 0, Name => Links::language('LINKS_TOP'), Full_Name => '' }
    }

# if the source and the target categories are the same then display the user an error
    if ($category_from == $category_to) {
        return $self->javascript_error ( message => Links::language ('BROWSER_MOVESELF'), tree_redraw => $category_from );
    }

# if the source and the target categories have the same name then display an error
    if ($category_from and $category_to and ($info_from->{Name} eq $info_to->{Name})) {
        return $self->javascript_error ( message => Links::language ('BROWSER_MOVEDUPE'), tree_redraw => $category_from );
    }

# if the source is a direct child of the target then we don't have anything to do
    if ($info_from->{FatherID} == $info_to->{ID}) {
        return $self->javascript_error ( message => Links::language ('BROWSER_MOVESELF'), tree_redraw => $category_from );
    }

# finally check that category_to isn't a category_from descendant
    my $from_full_name = $info_from->{Full_Name};
    my $to_full_name   = $info_to->{Full_Name};
    if ($to_full_name  =~ m,^\Q$from_full_name\E/,) {
        return $self->javascript_error ( message => Links::language ('BROWSER_MOVECHILD'), tree_redraw => $category_from );
    }

# update the record to point to the new father.
    my $old_father         = $info_from->{FatherID};
    $info_from->{FatherID} = $info_to->{ID};

# Remove the timestmp.
    delete $info_from->{Timestmp};

    $category->modify ($info_from)
        or return $self->javascript_error ( message => Links::language ('BROWSER_CANTMOD', _format_js ($GT::SQL::error)), tree_redraw => $category_from );

    my $navbar = $self->navbar ($info_from->{ID});
    my %info   = $self->_links_list_html ($category_from);
    $self->print_template ( "browser_category_move.html",
                               {
                                old              => $old_father,
                                new              => $info_from->{FatherID},
                                number_of_links  => $info_from->{Number_of_Links} || 0,
                                category_id      => $category_from,
                                category_to_id   => $category_to,
                                load_node_info   => $self->category_move_jscriptloop ($category_to),
                                navbar           => $navbar,
                                Name             => $info_from->{Name},
                                %info
                               }
                             );
}
END_OF_SUB

$COMPILE{category_move_jscriptloop} = __LINE__ . <<'END_OF_SUB';
sub category_move_jscriptloop {
# -------------------------------------------------------------------
# $obj->category_move_jscriptloop;
# -------------------------------------------
#   Returns the javascript commands that are used to
#   load the tree node whenever necessary.
#
    my $self        = shift;
    my $category    = $DB->table ('Category');
    my $category_to = shift;
    my @res = ();
    my $sth = $category->select ( { FatherID => $category_to }, ['ID', 'FatherID', 'Name'] )
                or die "An error has occurred: $GT::SQL::error";

    while (my $h = $sth->fetchrow_hashref) {
        my $file;
        if ($self->code_panel_init_loop_is_leaf ($category, $h->{ID})) {
            push @res, qq~parent.tree.addNode ( new parent.LoadedNode ( $h->{ID}, $h->{FatherID}, ~ . _quote($h->{Name}) . qq~ ) );~;
        }
        else {
            push @res, qq~parent.tree.addNode ( new parent.UnloadedNode ( $h->{ID}, $h->{FatherID}, ~ . _quote($h->{Name}) . qq~ ) );~;
        }
    }
    return join '', ("\n", @res);
}
END_OF_SUB

$COMPILE{category_move_jscriptloop_is_leaf} = __LINE__ . <<'END_OF_SUB';
sub category_move_jscriptloop_is_leaf {
# -------------------------------------------------------------------
# $obj->code_panel_init_loop_is_leaf ($id);
# -----------------------------------------
#   Returns TRUE if the category which id is $id has no
#   childs, FALSE otherwise.
#
    my $self     = shift;
    my $cat_id   = shift;
    my $category = $DB->table ('Category');
    my $sth      = $category->count ( { FatherID => $cat_id } );
    if ($sth->rows) { return 0 }
    else            { return 1 }
}
END_OF_SUB

$COMPILE{category_editors_form} = __LINE__ . <<'END_OF_SUB';
sub category_editors_form {
# -------------------------------------------------------------------
# Displays a list of existing editors, and lets the person add a new editor.
#
    my $self        = shift;
    my $category_id = $IN->param('category_id');
    my $category    = $DB->table('Category');
    my $cat_info    = $category->get ( { ID => $category_id }, 'HASH', ['Name'] )
                        or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDCATID', $category_id), info_go => -1);
# Remove any editors.
    my $editor_db   = $DB->table('Editors');
    my @to_delete   = $IN->param('delete');
    foreach my $editor_name (@to_delete) {
        my ($name, $id) = split /\|/, $editor_name;
        my $tmp         = $category->get ( { ID => $id }, 'HASH', ['Name'] )
                            or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDCATID', $id), info_go => -1);
        $editor_db->delete ( { Username => $name, CategoryID => $id });
    }

# Add any editors requested.
    if ($IN->param('Username')) {
        my $ed = $IN->get_hash;
        $ed->{CategoryID} = $category_id;
        $editor_db->insert ( $ed ) or return $self->javascript_error ( message => Links::language('BROWSER_EDITORADD', $ed->{Username} ), info_go => -1 );
    }

# Get a list of all the editors.
    my $parents     = $category->parents ( $category_id );
    push @$parents, $category_id;
    $parents        = '(' . join (",", @$parents) . ')';
    my $sth         = $editor_db->select ( GT::SQL::Condition->new('CategoryID', 'IN', \$parents) );
    my $output;
    while (my $editor = $sth->fetchrow_hashref) {
        my $cat_info = $category->get ($editor->{CategoryID}, 'HASH', ['Full_Name']);
        $editor->{Full_Name} = $cat_info->{Full_Name};
        $output .= $self->return_template ('browser_category_editors_row.html', $editor);
    }
    my $navbar = $self->navbar ($category_id);
    $self->print_template ( "browser_category_editors_form.html",
                               {
                                id          => $category_id,
                                navbar      => $navbar,
                                editors     => $output,
                                Name        => $cat_info->{Name}
                               }
                             );
}
END_OF_SUB

$COMPILE{category_related_form} = __LINE__ . <<'END_OF_SUB';
sub category_related_form {
# -------------------------------------------------------------------
# Adds related categories.
#
    my $self        = shift;
    my $category_id = $IN->param('category_id');
    my $name        = $IN->param('related_name');
    my $category    = $DB->table('Category');
    my $cat_info    = $category->get ( { ID => $category_id }, 'HASH', ['Name'] )
                        or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDCATID', $category_id), info_go => -1);
# Remove any relations.
    my @to_delete   = $IN->param('delete');
    my $relation_db = $DB->table('CatRelations');
    foreach my $relation (@to_delete) {
        $relation_db->delete ( { CategoryID => $category_id, RelatedID => $relation });
    }

# Add any relations requested.
    my $id = $IN->param('related_to');
    if ($id) {
        my $id_r  = $category->get ( { ID => $id }, ['ID'] ) or return $self->javascript_error ( message => Links::language('BROWSER_RELADD', $id ), info_go => -1 );
        if ($relation_db->count ( { RelatedID => $id, CategoryID => $category_id })) {
            return $self->javascript_error ( message => Links::language('BROWSER_RELADD', $id_r->{Name} ), info_go => -1 );
        }
        $relation_db->insert ( { CategoryID => $category_id, RelatedID => $id, RelationName => $name });
    }

# Get a list of all the Relations.
    my $sth = $relation_db->select ( { CategoryID => $category_id }, ['RelatedID', 'RelationName']);
    my $output;
    while (my ($id, $rel_name) = $sth->fetchrow_array) {
        my $name_r = $category->get ( { ID => $id }, 'HASH', ['Full_Name'] );
        $rel_name  = $rel_name ? " ($rel_name) " : '';
        my $url    = $category->as_url ( $name_r->{Full_Name} );
        $output .= qq~
<input type="checkbox" name="delete" value="$id"> <a href="$CFG->{build_root_url}/$url/$CFG->{build_index}" target="_blank">$name_r->{Full_Name}</a> $rel_name<br>
        ~;
    }
    my $navbar = $self->navbar ($category_id);
    $self->print_template ( "browser_category_related_form.html",
                               {
                                id          => $category_id,
                                navbar      => $navbar,
                                related     => $output,
                                Name        => $cat_info->{Name}
                               }
                             );

}
END_OF_SUB

# -------------------------------------------------------------------------------------- #
# LINK Management Functions                                                              #
# -------------------------------------------------------------------------------------- #

$COMPILE{link_user_list} = __LINE__ . <<'END_OF_SUB';
sub link_user_list {
# -------------------------------------------------------------------
# Displays a list of links owned by a given user.
#
    my $self        = shift;
    my $user        = $IN->param('user');
    my $category_id = $IN->param('category_id');
    my $navbar      = $self->navbar ($category_id);
    my $user_db     = $DB->table('Users');
    my $user_info   = $user_db->get ($user, 'HASH') or return $self->javascript_error ( message => Links::language ('BROWSER_INVALIDUSER', $user), hist_go => -1 );
    my %info        = $self->_links_list_html ($category_id, $user);
    $self->print_template ( "browser_link_owner.html",
                                {
                                    navbar       => $navbar,
                                    link_owner   => $user,
                                    %info,
                                    %$user_info
                                });
}
END_OF_SUB

$COMPILE{link_add_form} = __LINE__ . <<'END_OF_SUB';
sub link_add_form {
# -------------------------------------------------------------------
# $obj->_link_add_form;
# -------------------------------
#   Prints out an add form in order to let an user
#   add a link in a given category.
#
    my $self            = shift;
    my $category        = $DB->table ('Category');
    my $links           = $DB->table ('Links');
    my $category_id     = $IN->param ('category_id');
    my $navbar          = $self->navbar ($category_id);
    my $category_info   = $category->get ( { ID => $category_id }, 'HASH', ['ID', 'Name', 'Number_of_Links'] )
                            or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDCATID', $category_id) );

    if (! $IN->param('LinkOwener')) {
        $IN->param('LinkOwner', exists $self->{ctrl}->{user}->{Username} ? $self->{ctrl}->{user}->{Username} : 'admin');
    }
    my $h = $DB->html($links, $IN);
    $h->defaults(1);
    my $defaults = $h->_get_defaults();

    $self->print_template ( "browser_link_add_form.html",
                               {
                                %$defaults,
                                navbar      => $navbar,
                                Name        => $category_info->{Name},
                                category_id => $category_id,
                                form        => $h->form ( { defaults => 1, skip => [ qw /CatLinks.LinkID Timestmp/ ],
                                                            hide     => [qw/ID isNew isChanged isPopular Status Date_Checked Timestmp/],
                                                            file_field => 1, file_delete => 1
                                                          }) . "<input type=hidden name='CatLinks.CategoryID' value='$category_id'>"
                               } );
}
END_OF_SUB

$COMPILE{link_add} = __LINE__ . <<'END_OF_SUB';
sub link_add {
# -------------------------------------------------------------------
# adds a new link in the database system.
#
    my $self            = shift;
    my $category_id     = $IN->param ("CatLinks.CategoryID");
    my $category        = $DB->table ('Category');
    my $links           = $DB->table ('Links');
    my $navbar          = $self->navbar ($category_id);
    my $category_info   = $category->get ( { ID => $category_id }, 'HASH', ['ID', 'Name', 'Number_of_Links'] )
                            or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDCATID', $category_id), hist_go => -1 );

# Setup the language for GT::SQL.
    local $GT::SQL::ERRORS->{ILLEGALVAL} = Links::language('ADD_ILLEGALVAL') if Links::language('ADD_ILLEGALVAL') ne 'ADD_ILLEGALVAL';
    local $GT::SQL::ERRORS->{UNIQUE} = Links::language('ADD_UNIQUE') if Links::language('ADD_UNIQUE') ne 'ADD_UNIQUE';
    local $GT::SQL::ERRORS->{NOTNULL} = Links::language('ADD_NOTNULL') if Links::language('ADD_NOTNULL') ne 'ADD_NOTNULL';
    local $Links::Table::Links::ERRORS->{NOCATEGORY} = Links::language('ADD_NOCATEGORY') if Links::language('ADD_NOCATEGORY') ne 'ADD_NOCATEGORY';
    $Links::Table::Links::ERRORS if 0; # silence -w

    my $h = $IN->get_hash;
    _format_insert_cgi($h, $links);
    $links->add ($h)
                            or return $self->javascript_error ( message => Links::language('BROWSER_LINKCANTADD', _format_js($GT::SQL::error)), hist_go => -1 );
    my %info = $self->_links_list_html ($category_id);
    $self->print_template ( "browser_link_add.html",
                               {
                                Name   => $category_info->{Name},
                                navbar => $navbar,
                                id     => $category_id,
                                %info
                               } );
}
END_OF_SUB

$COMPILE{link_modify_form} = __LINE__ . <<'END_OF_SUB';
sub link_modify_form {
# -------------------------------------------------------------------
# prints a form to modify a link
#
    my $self            = shift;
    my $link_id         = $IN->param ('link_id');
    my $category_id     = $IN->param ('category_id');
    my $category        = $DB->table ('Category');
    my $links           = $DB->table ('Links');
    my $catlink         = $DB->table ('Category', 'CatLinks');
    my $navbar          = $self->navbar ($category_id);
    my $category_info   = $category->get ( { ID => $category_id }, 'HASH', ['ID', 'Name', 'Number_of_Links'] )
                            or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDCATID', $category_id), hist_go => -1 );
    my $link_info       = $links->get ( { ID => $link_id } )
                            or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDLINKID', $link_id), hist_go => -1 );
    $catlink->select_options("ORDER BY $CFG->{build_category_sort}");
    my $cats = $catlink->select({ LinkID => $link_id })->fetchall_hashref;

    my $h = $DB->html($links, $link_info);
    $h->view_key(1);
    $h->file_field(1);
    $h->file_delete(1);

    my $file_field = $h->{file_field};

    my $cols = $links->cols;
    foreach my $col (keys %$cols) {
        if (exists $cols->{$col}->{form_type} and $cols->{$col}->{form_type} eq 'FILE') {
            $h->{file_field} = 1;
            $link_info->{"${col}_filehtml"} = $h->file(
                { 
                    name => $col,
                    def  => $cols->{$col},
                    value => $link_info->{$col},
                },
                $link_info,
                {
                    db => $links
                }
            );
        }
    }
    $h->{file_field} = $file_field;

    $self->print_template ( "browser_link_modify_form.html",
                               {
                                %$link_info,
                                Name          => $category_info->{Name},
                                navbar        => $navbar,
                                category_id   => $category_id,
                                category_loop => $cats,
                                form          => $h->form ( { defaults => 1, skip => [ qw /CatLinks.LinkID Timestmp/ ],
                                                            hide     => [qw/ID isNew isChanged isPopular Status Date_Checked Timestmp/],
                                                            file_field => 1, file_delete => 1 
                                                          }) . "<input type=hidden name='CatLinks.CategoryID' value='$category_id'>"
                               } );
}
END_OF_SUB

$COMPILE{link_modify} = __LINE__ . <<'END_OF_SUB';
sub link_modify {
# -------------------------------------------------------------------
# modifies a link
#
    my $self            = shift;
    my $link_id         = $IN->param ('ID');
    my $category_id     = $IN->param ('category_id');
    my $category        = $DB->table ('Category');
    my $links           = $DB->table ('Links');
    my $navbar          = $self->navbar ($category_id);
    my $category_info   = $category->get ( { ID => $category_id }, 'HASH', ['ID', 'Name', 'Number_of_Links'] )
                            or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDCATID', $category_id), hist_go => -1 );
    my $link_info       = $links->get ( { ID => $link_id } )
                            or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDLINKID', $link_id), hist_go => -1 );

# Setup the language for GT::SQL.
    local $GT::SQL::ERRORS->{ILLEGALVAL} = Links::language('ADD_ILLEGALVAL') if Links::language('ADD_ILLEGALVAL') ne 'ADD_ILLEGALVAL';
    local $GT::SQL::ERRORS->{UNIQUE} = Links::language('ADD_UNIQUE') if Links::language('ADD_UNIQUE') ne 'ADD_UNIQUE';
    local $GT::SQL::ERRORS->{NOTNULL} = Links::language('ADD_NOTNULL') if Links::language('ADD_NOTNULL') ne 'ADD_NOTNULL';
    local $Links::Table::Links::ERRORS->{NOCATEGORY} = Links::language('ADD_NOCATEGORY') if Links::language('ADD_NOCATEGORY') ne 'ADD_NOCATEGORY';
    $Links::Table::Links::ERRORS if 0; # silence -w

    my $h = $IN->get_hash;
    _format_insert_cgi($h, $links);

    $h->{'CatLinks.CategoryID'} = $self->_build_category_id_set ($link_id);
    my $ret = $links->modify ($h) or return $self->javascript_error ( message => Links::language('BROWSER_LINKCANTMOD', _format_js($GT::SQL::error)), hist_go => -1 );

    my %info = $self->_links_list_html ($category_id);
    $self->print_template ( "browser_link_modify.html",
                               {
                                Name   => $category_info->{Name},
                                navbar => $navbar,
                                %info
                               } );
}
END_OF_SUB

$COMPILE{link_del_form} = __LINE__ . <<'END_OF_SUB';
sub link_del_form {
# -------------------------------------------------------------------
# outputs a link delete form
#
    my $self            = shift;
    my $link_id         = $IN->param ('link_id');
    my $category_id     = $IN->param ('category_id');
    my $category        = $DB->table ('Category');
    my $links           = $DB->table ('Links');
    my $navbar          = $self->navbar ($category_id);
    my $category_info   = $category->get ( { ID => $category_id }, 'HASH', ['ID', 'Name', 'Number_of_Links'] )
                            or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDCATID', $category_id), hist_go => -1 );
    my $link_info       = $links->get ( { ID => $link_id }, 'HASH', ['Title'] )
                            or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDLINKID', $link_id), hist_go => -1 );
    $self->print_template ( "browser_link_del_form.html",
                               {
                                navbar                     => $navbar,
                                Name                       => $category_info->{Name},
                                link                       => $link_info->{Title},
                                link_id                    => $link_id,
                                category_id                => $category_id
                               } );
}
END_OF_SUB

$COMPILE{link_del} = __LINE__ . <<'END_OF_SUB';
sub link_del {
# -------------------------------------------------------------------
# deletes a link from the database
#
    my $self            = shift;
    my $link_id         = $IN->param ('link_id');
    my $category_id     = $IN->param ('category_id');
    my $category        = $DB->table ('Category');
    my $links           = $DB->table ('Links');
    my $navbar          = $self->navbar ($category_id);
    my $category_info   = $category->get ( { ID => $category_id }, 'HASH', ['ID', 'Name', 'Number_of_Links'] )
                            or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDCATID', $category_id), hist_go => -1 );
    my $link_info       = $links->get ( { ID => $link_id }, 'HASH', ['Title'] )
                            or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDLINKID', $link_id), hist_go => -1 );

    my $rows = $links->delete ( { ID => $link_id, 'CatLinks.CategoryID' => $category_id } );
    if ($rows == 0) {
        return $self->javascript_error ( message => Links::language('BROWSER_LINKCANTDEL', _format_js($GT::SQL::error)), hist_go => -1 );
    }
    my %info = $self->_links_list_html ($category_id);
    $self->print_template ( "browser_link_del.html",
                               {
                                id      => $category_id,
                                Name    => $category_info->{Name},
                                navbar  => $navbar,
                                %info
                               } );
}
END_OF_SUB

$COMPILE{link_move_form} = __LINE__ . <<'END_OF_SUB';
sub link_move_form {
# -------------------------------------------------------------------
    my $self            = shift;
    my $link_id         = $IN->param ('link_id');
    my $category_id     = $IN->param ('category_id');
    my $category        = $DB->table ('Category');
    my $links           = $DB->table ('Links');
    my $navbar          = $self->navbar ($category_id);
    my $category_info   = $category->get ( { ID => $category_id }, 'HASH', ['Name'] )
                            or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDCATID', $category_id), hist_go => -1 );
    my $link_info       = $links->get ( { ID => $link_id }, 'HASH', ['Title'] )
                            or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDLINKID', $link_id), hist_go => -1 );

    $self->print_template ( "browser_link_move_form.html",
                               {
                                Name            => $category_info->{Name},
                                navbar          => $navbar,
                                old_category_id => $category_id,
                                link_move       => $link_id
                               } );
}
END_OF_SUB

$COMPILE{link_move} = __LINE__ . <<'END_OF_SUB';
sub link_move {
# -------------------------------------------------------------------
# moves a link into another category
#
    my $self                = shift;
    my $link_id             = $IN->param ('link_id');
    my $old_category_id     = $IN->param ('old_category_id');
    my $new_category_id     = $IN->param ('new_category_id');
    my $category            = $DB->table ('Category');
    my $links               = $DB->table ('Links');
    my $catlinks            = $DB->table ('CatLinks');
    my $navbar              = $self->navbar ($old_category_id);

# checks that the category id is not the root.
    if ($new_category_id == 0) {
        return $self->javascript_error ( message => Links::language('BROWSER_LINKMOVEROOT'), hist_go => -1 );
    }
    my $old_category_info   = $category->get ( { ID => $old_category_id }, 'HASH', ['Name'] )
                                or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDCATID', $old_category_id), hist_go => -1 );
    my $new_category_info   = $category->get ( { ID => $new_category_id }, 'HASH', ['Name'] )
                                or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDCATID', $new_category_id), hist_go => -1 );
    my $link_info           = $links->get ( { ID => $link_id } )
                                or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDLINKID', $link_id), hist_go => -1 );

# checks that the link does not exists in the target category
    my $exists = $catlinks->get ( { LinkID => $link_id, CategoryID => $new_category_id } );
    if ($exists) {
        return $self->javascript_error ( message => Links::language('BROWSER_LINKMOVEEXISTS'), hist_go => -1 );
    }

# Remove the timestamp.
    delete $link_info->{Timestmp};

# move the link.
    $link_info->{'CatLinks.CategoryID'} = $self->_build_category_id_set ($link_id, $old_category_id, $new_category_id);
    $links->modify ($link_info)
        or return $self->javascript_error ( message => Links::language('BROWSER_LINKCANTMOD', _format_js($GT::SQL::error)), hist_go => -1 );
    my %info = $self->_links_list_html ($old_category_id);
    $self->print_template ( "browser_link_move.html",
                               {
                                old    => $old_category_id,
                                new    => $new_category_id,
                                Name   => $old_category_info->{Name},
                                New_Name => $new_category_info->{Name},
                                navbar => $navbar,
                                %info
                               } );
}
END_OF_SUB

$COMPILE{link_copy_form} = __LINE__ . <<'END_OF_SUB';
sub link_copy_form {
# -------------------------------------------------------------------
# outputs a form that can be used to copy a link
#
    my $self            = shift;
    my $link_id         = $IN->param ('link_id');
    my $category_id     = $IN->param ('category_id');
    my $category        = $DB->table ('Category');
    my $links           = $DB->table ('Links');
    my $navbar          = $self->navbar ($category_id);
    my $category_info   = $category->get ( { ID => $category_id }, 'HASH', ['Name'] )
                            or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDCATID', $category_id), hist_go => -1 );
    my $link_info       = $links->get ( { ID => $link_id }, 'HASH', ['Title'] )
                            or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDLINKID', $link_id), hist_go => -1 );

    $self->print_template ( "browser_link_copy_form.html",
                               {
                                navbar => $navbar,
                                Name   => $category_info->{Name},
                                old_category_id => $category_id,
                                link_copy => $link_id,
                               } );
}
END_OF_SUB

$COMPILE{link_copy} = __LINE__ . <<'END_OF_SUB';
sub link_copy {
# -------------------------------------------------------------------
# copies a link in another category
#
    my $self                = shift;
    my $link_id             = $IN->param ('link_id');
    my $old_category_id     = $IN->param ('old_category_id');
    my $new_category_id     = $IN->param ('new_category_id');
    my $category            = $DB->table ('Category');
    my $links               = $DB->table ('Links');
    my $catlinks            = $DB->table ('CatLinks');
    my $navbar              = $self->navbar ($old_category_id);

# checks that the category id is not the root.
    if ($new_category_id == 0) {
        return $self->javascript_error ( message => Links::language('BROWSER_LINKMOVEROOT'), hist_go => -1 );
    }
    my $old_category_info   = $category->get ( { ID => $old_category_id }, 'HASH', ['Name'] )
                                or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDCATID', $old_category_id), hist_go => -1 );
    my $new_category_info   = $category->get ( { ID => $new_category_id }, 'HASH', ['Name'] )
                                or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDCATID', $new_category_id), hist_go => -1 );
    my $link_info           = $links->get ( { ID => $link_id } )
                                or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDLINKID', $link_id), hist_go => -1 );

# checks that the link does not exists in the target category
    my $exists = $catlinks->get ( { LinkID => $link_id, CategoryID => $new_category_id } );
    if ($exists) {
        return $self->javascript_error ( message => Links::language('BROWSER_LINKMOVEEXISTS'), hist_go => -1 );
    }

# Remove the timestamp.
    delete $link_info->{Timestmp};

    $link_info->{'CatLinks.CategoryID'} = $self->_build_category_id_set ($link_id, undef, $new_category_id);
    $links->modify ($link_info)
        or return $self->javascript_error ( message => Links::language('BROWSER_LINKCANTMOD', _format_js($GT::SQL::error)), hist_go => -1 );
    my %info = $self->_links_list_html ($old_category_id);
    $self->print_template ( "browser_link_copy.html",
                               {
                                new      => $new_category_id,
                                navbar   => $navbar,
                                Name     => $old_category_info->{Name},
                                New_Name => $new_category_info->{Name},
                                %info
                               } );
}
END_OF_SUB

$COMPILE{link_validate_list} = __LINE__ . <<'END_OF_SUB';
sub link_validate_list {
# -------------------------------------------------------------------
# Displays a list of links to validate.
#
    my $self        = shift;
    my ($limit, $offset, $page) = Links::limit_offset();
    $limit = 200 if $limit > 200; # Safety limit;
    my $base        = $self->{ctrl}->user_base_node;
    my $category_id = $IN->param('category_id');
    my $navbar      = $self->navbar($category_id);
    my $perms       = $self->{ctrl}->perms($category_id);

    my $sb = $IN->param('sb') || $IN->param('cookie-link_validate_sb') || $IN->cookie('link_validate_sb') || '';
    $sb = 'Add_Date' unless $sb =~ /^(?:ID|Title|URL|LinkOwner|Add_Date)$/;
    my $so = $IN->param('so') || $IN->param('cookie-link_validate_so') || $IN->cookie('link_validate_so') || '';
    $so = 'DESC' if $so ne 'DESC' and $so ne 'ASC';

    my $lnk_db = $DB->table('Links', 'CatLinks');
    $lnk_db->select_options("ORDER BY $sb $so", "LIMIT $limit OFFSET $offset");
    my $sth;
    my $singlecat = $IN->param('only_this_category');
    if (@$base) {
        my $cat_db = $DB->table('Category');

        my @ids;
        for my $id (@$base) {
            next if $singlecat and $category_id != 0 and $id != $category_id;
            if ($singlecat) {
                push @ids, $id;
                last;
            }
            else {
                my $children = $cat_db->children($id) or next;
                push @ids, $id, @$children;
            }
        }
        $sth = $lnk_db->select({ CategoryID => \@ids, isValidated => 'No' });
    }
    else {
        if ($singlecat and $category_id != 0) {
            $sth = $lnk_db->select({ CategoryID => $category_id, isValidated =>, 'No' });
        }
        else {
            $sth = $lnk_db->select({ isValidated =>, 'No' });
        }
    }
    my $count = $lnk_db->hits;

# Generate toolbar.
    my $tb;
    if ($count > $limit) {
        my $cgi = new GT::CGI;
        $cgi->param('action', 'link_validate_list');
        $cgi->param('category_id', $category_id);
        $tb = $DB->html($lnk_db, $IN)->toolbar($page, $limit, $count, $cgi->url);
    }

# Get list of links.
    my $output = '';
    while (my $link = $sth->fetchrow_hashref) {
        $output .= $self->return_template("browser_link_list.html",
                                  {
                                      category_id      => $link->{CategoryID},
                                      hasChangeRequest => 0,
                                      linkowner_esc    => GT::CGI->escape($link->{LinkOwner}),
                                      %$link,
                                      %$perms
                                  }
                         );
    }
    my $info = { toolbar => $tb, links => $output, count => $count, category_id => $category_id, navbar => $navbar, so => $so, sb => $sb };
    $self->print_template("browser_validate_links.html", $info);
}
END_OF_SUB

$COMPILE{link_validate_detailed} = __LINE__ . <<'END_OF_SUB';
sub link_validate_detailed {
# -------------------------------------------------------------------
# Displays a list of links and forms for validation
#
    my $self = shift;

# The Browser::Controller removes all listings of entries that the user does 
# not have permission to validate. Thus, the following code does not perform any
# additional security checks. 
    my $db       = $DB->table( 'Links' );
    my $user_db  = $DB->table( 'Users' );
    my $cat_link = $DB->table( 'CatLinks' );

# 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) {
        if ($key =~ /^(\d+)-(.*)$/) {
            $tmp->{$1}->{$2} = $param;
        }
    }
    my $links = {};
    foreach (keys %$tmp) {
        $links->{$tmp->{$_}->{ID}} = $tmp->{$_};
    }

    my ( @errors, @validated, $chng_db );
    require Links::Tools;
    for my $link_id ( keys %$links ) {
        my $link_info = $links->{$link_id};

        $link_info->{'CatLinks.CategoryID'} = $self->_build_category_id_set($link_id);

        my $error;

        $_ = $args->{"validate-$link_id"} or next;

        CASE: {

            /^validate$/ and do {
                 $link_info->{_mode} = 'validate';
                 $error = $PLG->dispatch('validate_link', \&Links::Tools::_validate_record, $link_info);
                last;
            };

            /^email$/ and do {
                $error = Links::Tools::_delete_email_record($db, $user_db, $link_info, $link_info->{reason});
                last;
            };

            /^delete$/ and do {
                Links::Tools::_delete_record( $db, $link_id ) or ($error = $GT::SQL::error);
                last;
            };

            /^modify$/ and do {
                $link_info->{_mode} = 'modify';
                $error = $PLG->dispatch('validate_link', \&Links::Tools::_validate_record, $link_info );
                if (! $error) {
                    $chng_db ||= $DB->table ('Changes');
                    $chng_db->delete( { LinkID => $link_id } );
                }
                last;
            };

            /^delete_change$/ and do {
                $error = Links::Tools::_delete_email_change_record($db, $user_db, $link_info, $link_info->{reason});
                Links::Tools::_delete_change( $link_id ) or ($error = $GT::SQL::error);
                last;
            };

            /^email_change$/ and do {
                $error = Links::Tools::_delete_email_change_record($db, $user_db, $link_info, $link_info->{reason});
                last;
            };

        };

        push @errors, $error if $error;
        push @validated, $link_id;
    }

    my $val_result = '';
    @validated and $val_result = @errors
                                    ? Links::language( 'BROWSER_VALIDATE_ERROR', join( "", @errors ) )
                                    : Links::language( 'BROWSER_VALIDATE_OK' );

# Continue on with the normal display of links awaiting validation

    my ($limit, $offset, $page) = Links::limit_offset();
    $limit = 200 if $limit > 200; # Safety limit;
    my $base        = $self->{ctrl}->user_base_node;
    my $category_id = $IN->param('category_id');
    my $navbar      = $self->navbar($category_id);
    my $perms       = $self->{ctrl}->perms($category_id);

# Prepare the values of basic operational parameters
    my $sb          = $IN->param('sb') || $IN->param('cookie-link_validate_detailed_sb') || $IN->cookie('link_validate_detailed_sb') || '';
    $sb             = 'Add_Date' unless $sb =~ /^(?:ID|Title|URL|LinkOwner|Add_Date)$/;
    my $so          = $IN->param('so') || $IN->param('cookie-link_validate_detailed_so') || $IN->cookie('link_validate_detailed_so') || '';
    $so             = 'DESC'     unless $so =~ /^(?:DESC|ASC)$/;
    my $mh          = int( $IN->param('mh') || 0 ) || 25;
    my $update      = $IN->param('update');

# Fetch the IDs of the categories the user is allowed to validate. This will
# also account for the situation when the user will attempt to search
# within a single category and not look within subcategories
    my ( @cat_ids, $cond );
    my $singlecat   = $IN->param('only_this_category');
    my $cat_db      = $DB->table( 'Category' );
    if ( @$base ) {
        for my $cat_id ( @$base ) {

# If the user has requested only a single category, we will filter out
# everything but that single c ategory
            next if $singlecat 
                    and $category_id != 0 
                    and $cat_id      != $category_id;

# Include that single category
            if ( $singlecat ) {
                push @cat_ids, $cat_id;
                last;
            }

# Otherwise, include this particular category and all subcatgories
            else {
                my $children = $cat_db->children($cat_id) or next;
                push @cat_ids, $cat_id, @$children;
            }
        }

        $cond = { CategoryID => \@cat_ids };
    }
    elsif ( $singlecat and $category_id  != 0 ) {
        $cond = { CategoryID => $category_id };
    }
    else {
        $cond = {};
    };

# Now, with the list of all categories the user is permitted to access, attempt to 
# find the all links/changes 
    my ( $link_hits_sth, $link_count );

# If this is an "update" search, must pull from the changes database
    if ( $update ) {
        my $cat_search_db = $DB->table( 'CatLinks', 'Changes', 'Links' );
        $cat_search_db->select_options(
            "GROUP BY LinkID", 
            "ORDER BY $sb $so", 
            "LIMIT $limit OFFSET $offset"
        );
        $link_hits_sth = $cat_search_db->select( 'Links.*', 'Changes.*', $cond );
        $link_count    = $cat_search_db->hits;
    }

# This is a standard validate records search so pull from the Links database
# with attention to which category the record is coming from 
    else {
        my $cat_search_db = $DB->table( 'Links', 'CatLinks' );
        $cat_search_db->select_options("ORDER BY $sb $so", "LIMIT $limit OFFSET $offset");
        $cond->{isValidated} = 'No';
        $link_hits_sth = $cat_search_db->select( $cond );
        $link_count    = $cat_search_db->hits;
    }

# At this point, there is a handle to all the new links and a count of 
# hits available. Thus, it is possible to find out if a toolbar is required
    my $tb;
    if ($link_count > $limit) {
        my $cgi = GT::CGI->new(
            "category_id=$category_id;"
            . "action=link_validate_detailed;"
            . "mh=$mh;"
            . "so=$so;"
            . "sb=$sb;"
        );
        $tb = $DB->html($db, $IN)->toolbar($page, $limit, $link_count, $cgi->url);
    }

# And finally, it is posible to get a list of all the links that are available to
# the user to validate
    my $output = '';

    Links::init_date();

    my $today = GT::Date::date_get();
    my $i     = 0;
    while (my $link = $link_hits_sth->fetchrow_hashref) {
        $i++;

        my $link_info = $update ? eval $link->{ChgRequest} : $link;

        $link->{'CatLinks.CategoryID'} = [$cat_link->select('CategoryID', { LinkID => $link_info->{ID} })->fetchall_list];

# Load reason before setting the Add_Date/Mod_Date to today.
        my $reason;
        {
            local $USER;
            my $user = $user_db->get($link_info->{LinkOwner}) || {};
            $reason  = Links::send_email('link_rejected.eml', { %$user, %$link_info }, { get_body => 1 });
        };

# Set Add_Date/Mod_Date, so if the link gets validated, it gets set to the current date.
        $link_info->{Add_Date} = $today if $CFG->{link_validate_date} and not $update;
        $link_info->{Mod_Date} = $today;

# Then, automatically create the HTML form that will allow modification to the editor
        my $html     = $DB->html( $db, $link_info );
        my $form = $html->form({
            defaults      => 1,
            multiple      => $i,
            skip          => [qw/CatLinks.LinkID Timestmp/],
            hide          => [qw/ID isNew isChanged isPopular isValidated Status Date_Checked Timestmp/],
            extra_table   => 0,
            file_field    => 1,
            file_delete   => 1,
            file_use_path => $update,
            show_diff     => $update,
            values        => $link_info
        });

# And add any supporting HTML that can may be used to display each record
        $output .= $self->return_template(
            'browser_validate_detailed_form.html',
            { 
                %$link_info,
                form   => $form, 
                update => $update,
                reason => $reason,
            }
        );
    }

    my $info = { 
        toolbar     => $tb, 
        links       => $output, 
        count       => $link_count, 
        category_id => $category_id, 
        navbar      => $navbar,
        result      => $val_result,
        so          => $so,
        sb          => $sb,
    };
    $self->print_template("browser_validate_detailed.html", $info);
}
END_OF_SUB

$COMPILE{link_validate_changes_list} = __LINE__ . <<'END_OF_SUB';
sub link_validate_changes_list {
# -------------------------------------------------------------------
# Displays a list of links to validate.
#
    my $self        = shift;
    my ($limit, $offset, $page) = Links::limit_offset();
    $limit = 200 if $limit > 200; # Safety limit;
    my $base        = $self->{ctrl}->user_base_node;
    my $category_id = $IN->param('category_id');
    my $navbar      = $self->navbar($category_id);
    my $perms       = $self->{ctrl}->perms($category_id);

    my $sb = $IN->param('sb') || $IN->param('cookie-link_validate_changes_sb') || $IN->cookie('link_validate_changes_sb') || '';
    $sb = 'Add_Date' unless $sb =~ /^(?:ID|Title|URL|LinkOwner|Add_Date)$/;
    my $so = $IN->param('so') || $IN->param('cookie-link_validate_changes_so') || $IN->cookie('link_validate_changes_so') || '';
    $so = 'DESC' if $so ne 'DESC' and $so ne 'ASC';

    my $cond;
    my $singlecat = $IN->param('only_this_category');
    if (@$base) {
        my @ids;
        my $cat = $DB->table('Category');
        for my $id (@$base) {
            next if $singlecat and $category_id != 0 and $id != $category_id;
            if ($singlecat) {
                push @ids, $id;
                last;
            }
            else {
                my $children = $cat->children($id) or next;
                push @ids, $id, @$children;
            }
        }
        $cond = { CategoryID => \@ids };
    }
    elsif ($singlecat and $category_id != 0) {
        $cond = { CategoryID => $category_id };
    }
    my $table = $DB->table('CatLinks', 'Changes', 'Links');
    $table->select_options("GROUP BY LinkID", "ORDER BY $sb $so", "LIMIT $limit OFFSET $offset");
    my $sth = $table->select('Links.*', 'CatLinks.*', $cond);
    my $count = $table->hits;

# Generate toolbar.
    my $tb;
    if ($count > $limit) {
        my $cgi = new GT::CGI;
        $cgi->param('action', 'link_validate_changes_list');
        $cgi->param('category_id', $category_id);
        $tb = $DB->html($DB->table('Links'), $IN)->toolbar($page, $limit, $count, $cgi->url);
    }

# Get list of links.
    my $output = '';
    while (my $link = $sth->fetchrow_hashref) {
        $output .= $self->return_template("browser_link_list.html",
                                  {
                                      category_id      => $link->{CategoryID},
                                      hasChangeRequest => 1,
                                      linkowner_esc    => GT::CGI->escape($link->{LinkOwner}),
                                      %$link,
                                      %$perms
                                  }
                         );
    }
    my $info = { toolbar => $tb, links => $output, count => $count, category_id => $category_id, navbar => $navbar, update => 1, so => $so, sb => $sb };
    $self->print_template("browser_validate_links.html", $info);
}
END_OF_SUB

$COMPILE{link_validate_form} = __LINE__ . <<'END_OF_SUB';
sub link_validate_form {
# -------------------------------------------------------------------
# Displays a link to validate.
#
    my $self            = shift;
    my $link_id         = $IN->param ('link_id');
    my $category_id     = $IN->param ('category_id');
    my $category        = $DB->table ('Category');
    my $links           = $DB->table ('Links');
    my $navbar          = $self->navbar ($category_id);
    my $category_info   = $category->get ( { ID => $category_id }, 'HASH', ['ID', 'Name', 'Number_of_Links'] )
                            or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDCATID', $category_id), hist_go => -1 );

    my $link_info;
    my $update = $IN->param('update');
    if ($update) {
        my $change_db = $DB->table ('Changes');
        my $link = $change_db->get ({ LinkID => $link_id })
                            or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDLINKID', $GT::SQL::error), hist_go => -1 );
        $link_info = eval $link->{ChgRequest};
        if ($@) {
            die "Unable to update link: $@";
        }

# Old Change requests may contain ExpiryDate, which can overwrite payments made
# by the user after making a modify request.  Delete it so the ExpiryDate is
# pulled from the current link data.
        delete $link_info->{ExpiryDate};

# Only the changed column data are saved in the Changes table
        my $orig = $links->get({ ID => $link_id }) || {};
        $link_info = { %$orig, %$link_info };

# Check that the ExpiryDate is valid for the categories the link is in
        if ($CFG->{payment}->{enabled}) {
            require Links::Payment;
            my $expiry = Links::Payment::check_expiry_date($orig, $link_info->{'CatLinks.CategoryID'});
            $link_info->{ExpiryDate} = $expiry if $expiry;
        }
    }
    else {
        $link_info = $links->get({ ID => $link_id })
                        or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDLINKID', $link_id), hist_go => -1 );
    }

# Set Add_Date/Mod_Date, so if the link gets validated, it gets set to the current date.
    my $today = GT::Date::date_get();
    $link_info->{Add_Date} = $today if $CFG->{link_validate_date} and not $update;
    $link_info->{Mod_Date} = $today;

    my $h = $DB->html($links, $link_info);

    my $form = $h->form({
        defaults => 1,
        skip => [qw/CatLinks.LinkID Timestmp/],
        hide => [qw/ID isNew isChanged isPopular isValidated Status Date_Checked Timestmp/],
        extra_table => 0,
        file_field => 1,
        file_delete => 1,
        file_use_path => $update,
        show_diff => $update,
        values => $link_info
    });

    if ($update) {
        # Hack needed to convert do=download_file into download_tmp_file, and
        # remove the fname parameter (which contains a full path).
        $form =~ s/(<a href="browser\.cgi\?(?:[^"]+&)?do=(?:download|view))(_file(?:&|$))/${1}_tmp$2/g;
        $form =~ s{(<a href="browser\.cgi\?(?:[^"]+&)?)fname=[^&;]+(?:&|$)}{$1}g;
    }

# We don't want $USER to contain the current user's info
    my $curr_user = $USER;
    $USER = {};
    my $user = $DB->table('Users')->get($link_info->{LinkOwner}) || {};
    my $reason = Links::send_email('link_rejected.eml', { %$user, %$link_info }, { get_body => 1 });
    $USER = $curr_user;

    $self->print_template ( "browser_link_validate_form.html",
                               {
                                Name        => $category_info->{Name},
                                navbar      => $navbar,
                                category_id => $category_id,
                                reason      => $reason,
                                update      => $update,
                                form        => $form . "<input type=hidden name='CatLinks.CategoryID' value='$category_id'>",
                                %$link_info
                               } );

}
END_OF_SUB

$COMPILE{link_validate} = __LINE__ . <<'END_OF_SUB';
sub link_validate {
# -------------------------------------------------------------------
# Validates a link.
#
    my $self            = shift;
    my $link_id         = $IN->param ('ID');
    my $category_id     = $IN->param ('category_id');
    my $category        = $DB->table ('Category');
    my $links           = $DB->table ('Links');
    my $email           = $DB->table ('Users');
    my $navbar          = $self->navbar ($category_id);
    my $category_info   = $category->get ( { ID => $category_id }, 'HASH', ['ID', 'Name', 'Number_of_Links'] )
                            or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDCATID', $category_id), hist_go => -1 );
    my $link_info       = $links->get ( { ID => $link_id } )
                            or return $self->javascript_error ( message => Links::language('BROWSER_INVALIDLINKID', $link_id), hist_go => -1 );

    my $h = $IN->get_hash;
    $h->{'CatLinks.CategoryID'} = $self->_build_category_id_set ($link_id);

    require Links::Tools;
    my $action = $IN->param('validate');
    my ($error, $chng_db);

    CASE: {
        ($action eq 'validate')     and do {
                                             $h->{_mode} = 'validate';
                                             $error = $PLG->dispatch('validate_link', \&Links::Tools::_validate_record, $h);
                                             last CASE;
                                            };
        ($action eq 'modify')       and do {
                                             $h->{_mode} = 'modify';
                                             $error = $PLG->dispatch('validate_link', \&Links::Tools::_validate_record, $h);
                                             if (! $error) {
                                                 $chng_db ||= $DB->table ('Changes');
                                                 $chng_db->delete ( { LinkID => $h->{ID} } );
                                             }
                                             last CASE;
                                           };
        ($action eq 'delete')       and do { Links::Tools::_delete_record ( $links, $link_id ) or ($error = $GT::SQL::error); last CASE; };
        ($action eq 'delete_change')and do { Links::Tools::_delete_change ( $link_id ) or ($error = $GT::SQL::error); last CASE; };
        ($action eq 'email')        and do { $error = Links::Tools::_delete_email_record ($links, $email, $h, $h->{reason}); last CASE; };
        ($action eq 'email_change') and do { $error = Links::Tools::_delete_email_change_record ($links, $email, $h, $h->{reason}); last CASE; };
    }
    my %info = $self->_links_list_html ($category_id);
    $self->print_template ( "browser_link_validate.html",
                               {
                                id     => $category_id,
                                action => $action,
                                error  => $error,
                                Name   => $category_info->{Name},
                                navbar => $navbar,
                                %info
                    });
}
END_OF_SUB

$COMPILE{review_list} = __LINE__ . <<'END_OF_SUB';
sub review_list {
# -------------------------------------------------------------------
# Displays a list of reviews.
#
    my $self = shift;
    my ($limit, $offset, $page) = Links::limit_offset();
    $limit = 200 if $limit > 200; # Safety limit;
    my $cat_id = $IN->param('category_id');
    my $link_id = $IN->param('link_id');
    my $perms = $self->{ctrl}->perms($cat_id);

    my $sb = $IN->param('sb') || $IN->param('cookie-review_sb') || $IN->cookie('review_sb') || '';
    $sb = 'Review_Date' unless $sb =~ /^Review_(?:Owner|Date|Subject)$/;
    my $so = $IN->param('so') || $IN->param('cookie-review_so') || $IN->cookie('review_so') || '';
    $so = 'DESC' if $so ne 'DESC' and $so ne 'ASC';

    my ($tb, $sth, $count);
    if ($link_id) {
        $tb = $DB->table('Reviews', 'Links');
        $tb->select_options("ORDER BY $sb $so", "LIMIT $limit OFFSET $offset");
        $sth = $tb->select({ Review_LinkID => $link_id });
    }
    else {
        $tb = $DB->table('Reviews', 'Links', 'CatLinks');
        $tb->select_options("ORDER BY $sb $so", "LIMIT $limit OFFSET $offset");
        my $singlecat = $IN->param('only_this_category');
        my $base = $self->{ctrl}->user_base_node;
        if (@$base) {
            my $cat = $DB->table('Category');

            my @ids;
            for my $id (@$base) {
                next if $singlecat and $cat_id != 0 and $id != $cat_id;
                if ($singlecat) {
                    push @ids, $id;
                }
                else {
                    my $children = $cat->children($id) or next;
                    push @ids, $id, @$children;
                }
            }
            $sth = $tb->select({ CategoryID => \@ids, Review_Validated => 'No' });
        }
        else {
            if ($singlecat and $cat_id != 0) {
                $sth = $tb->select({ CategoryID => $cat_id, Review_Validated => 'No' });
            }
            else {
                $sth = $tb->select({ Review_Validated =>, 'No' });
            }
        }
    }
    $count = $tb->hits;

# Generate toolbar.
    my $toolbar;
    if ($count > $limit) {
        my $cgi = new GT::CGI;
        $cgi->param('action', 'review_list');
        $cgi->param('category_id', $cat_id);
        $toolbar = $DB->html($tb, $IN)->toolbar($page, $limit, $count, $cgi->url);
    }

# Get list of links.
    my $output = '';
    while (my $review = $sth->fetchrow_hashref) {
        $output .= $self->return_template("browser_review_list.html", {
            category_id => $cat_id,
            %$review,
            %$perms
        });
    }

    $self->print_template("browser_reviews.html", {
        toolbar     => $toolbar,
        links       => $output,
        count       => $count,
        category_id => $cat_id,
        navbar      => $self->navbar($cat_id),
        so          => $so,
        sb          => $sb,
    });
}
END_OF_SUB

$COMPILE{review_del_form} = __LINE__ . <<'END_OF_SUB';
sub review_del_form {
# -------------------------------------------------------------------
# Displays a form to delete a review.
#
    my $self = shift;
    my $review_id = $IN->param('review_id');
    my $cat_id = $IN->param('category_id');

    my $review = $DB->table('Reviews', 'Links')->select({ ReviewID => $review_id })->fetchrow_hashref;
    return $self->javascript_error(message => Links::language('BROWSER_INVALIDREVIEWID', $review_id), hist_go => -1) unless $review;

    $self->print_template("browser_review_del_form.html", {
        navbar      => $self->navbar($cat_id),
        category_id => $cat_id,
        review_id   => $review_id,
        %$review
    });
}
END_OF_SUB

$COMPILE{review_del} = __LINE__ . <<'END_OF_SUB';
sub review_del {
# -------------------------------------------------------------------
# Delete a review.
#
    my $self = shift;
    my $review_id = $IN->param('review_id');
    my $cat_id = $IN->param('category_id');

    my $review = $DB->table('Reviews', 'Links')->select({ ReviewID => $review_id })->fetchrow_hashref;
    return $self->javascript_error(message => Links::language('BROWSER_INVALIDREVIEWID', $review_id), hist_go => -1) unless $review;

# Make sure the user is allowed to delete reviews in the category the review's link is in.
    my $base = $self->{ctrl}->user_base_node;
    if (@$base) {
        my $cat = $DB->table('Category');
        my @ids;
        for my $id (@$base) {
            my $children = $cat->children($id) or next;
            push @ids, $id, @$children;
        }
        unless ($DB->table('CatLinks')->count({ LinkID => $review->{Review_LinkID}, CategoryID => \@ids })) {
            return $self->javascript_error(message => Links::language('BROWSER_UNAUTHORIZED', $review_id), hist_go => -1);
        }
    }

    $DB->table('Reviews')->delete({ ReviewID => $review_id });

    $self->print_template("browser_review_result.html", {
        navbar      => $self->navbar($cat_id),
        category_id => $cat_id,
        review_id   => $review_id,
        delete      => 1,
        %$review
    });
}
END_OF_SUB

$COMPILE{review_modify_form} = __LINE__ . <<'END_OF_SUB';
sub review_modify_form {
# -------------------------------------------------------------------
# Displays a review to modify/validate.
#
    my $self = shift;
    my $review_id = $IN->param('review_id');
    my $cat_id = $IN->param('category_id');

    my $review = $DB->table('Reviews', 'Links')->select({ ReviewID => $review_id })->fetchrow_hashref;
    return $self->javascript_error(message => Links::language('BROWSER_INVALIDREVIEWID', $review_id), hist_go => -1) unless $review;

# We don't want $USER to contain the current user's info
    my $reason;
    if ($IN->param('validate')) {
        my $curr_user = $USER;
        $USER = {};

        my $user = $DB->table('Users')->get($review->{Review_Owner}) || {};
        my $link = $DB->table('Links')->get($review->{Review_LinkID}) || {};
        $link->{detailed_url} = "$CFG->{build_detail_url}/" . $DB->table('Links')->detailed_url($link->{ID});
        $reason = Links::send_email('review_rejected.eml', { %$user, %$link, %$review }, { get_body => 1 });

        $USER = $curr_user;
    }
    $self->print_template("browser_review_modify_form.html", {
        navbar      => $self->navbar($cat_id),
        category_id => $cat_id,
        reason      => $reason,
        form        => $DB->html($DB->table('Reviews'), $review)->form({
                           defaults => 1,
                           hide => [qw/ReviewID Review_LinkID Review_Rating Review_WasHelpful Review_WasNotHelpful/],
                           file_field => 1, file_delete => 1, extra_table => 0
                       }),
        %$review
    });
}
END_OF_SUB

$COMPILE{review_modify} = __LINE__ . <<'END_OF_SUB';
sub review_modify {
# -------------------------------------------------------------------
# Modifies a review.
#
    my $self = shift;
    my $review_id = $IN->param('ReviewID');
    my $cat_id = $IN->param('category_id');
    my $validate = $IN->param('validate');
    my $action = $IN->param('do');

    my $review = $DB->table('Reviews')->select({ ReviewID => $review_id })->fetchrow_hashref;
    return $self->javascript_error(message => Links::language('BROWSER_INVALIDREVIEWID', $review_id), hist_go => -1) unless $review;
    return $self->javascript_error(message => Links::language('BROWSER_REVIEWVALIDATED'), hist_go => -1) if $validate and $review->{Review_Validated} eq 'Yes';

# Make sure the user is allowed to modify reviews in the category the review's link is in.
    my $base = $self->{ctrl}->user_base_node;
    if (@$base) {
        my $cat = $DB->table('Category');
        my @ids;
        for my $id (@$base) {
            my $children = $cat->children($id) or next;
            push @ids, $id, @$children;
        }
        unless ($DB->table('CatLinks')->count({ LinkID => $review->{Review_LinkID}, CategoryID => \@ids })) {
            return $self->javascript_error(message => Links::language('BROWSER_UNAUTHORIZED', $review_id), hist_go => -1);
        }
    }

    my $error;
    my $in = $IN->get_hash;
    require Links::Tools;
    if ($action eq 'modify') {
        delete $in->{ReviewID};
        my $id = delete $in->{Review_LinkID};
        $DB->table('Reviews')->update($in, { ReviewID => $review_id }) or $error = $GT::SQL::error;
# Update the Timestmp for the link so the detailed pages get rebuilt with build changed
        $DB->table('Links')->update({ Timestmp => \'NOW()' }, { ID => $id });
    }
    elsif ($action eq 'validate') {
        $error = $PLG->dispatch('validate_review', \&Links::Tools::_validate_review_record, $in);
    }
    elsif ($action eq 'email') {
        Links::Tools::_delete_email_review_record($in, $in->{reason});
    }
    elsif ($action eq 'delete') {
        $DB->table('Reviews')->delete({ ReviewID => $review_id });
    }

    $self->print_template("browser_review_result.html", {
        action      => $action,
        error       => $error,
        category_id => $cat_id,
        navbar      => $self->navbar($cat_id)
    });
}
END_OF_SUB

$COMPILE{link_search_form} = __LINE__ . <<'END_OF_SUB';
sub link_search_form {
# -------------------------------------------------------------------
# $obj->_link_search_form;
# -------------------------------
#   Prints out a search form in order to let a user
#   search for links.
#
    my $self            = shift;
    my $error           = shift;
    my $category        = $DB->table('Category');
    my $links           = $DB->table('Links');
    my $category_id     = $IN->param('category_id');
    my $navbar          = $self->navbar($category_id);
    my $category_info   = $category->get({ ID => $category_id }, 'HASH', ['ID', 'Name', 'Number_of_Links'] )
                            or return $self->javascript_error( message => Links::language('BROWSER_INVALIDCATID', $category_id) );

    my $h = $DB->html($links, $IN);
    $self->print_template( "browser_link_search_form.html",
                               {
                                error       => $error,
                                navbar      => $navbar,
                                Name        => $category_info->{Name},
                                category_id => $category_id,
                                form        => $h->form ( { defaults => 0, skip => [ qw /CatLinks.LinkID Timestmp/ ],
                                                            file_field => 1, file_delete => 1, search_opts => 1,
                                                          }) . "<input type=hidden name='CatLinks.CategoryID' value='$category_id'>"
                               } );
}
END_OF_SUB

$COMPILE{link_search_results} = __LINE__ . <<'END_OF_SUB';
sub link_search_results {
# -------------------------------------------------------------------
# $obj->_link_search_results;
# ------------------------------
#   Prints out the search results
#
    my $self = shift;
    my $category_id = $IN->param('category_id');
    my $change_db = $DB->table('Changes');

    my ($limit, $offset, $page) = Links::limit_offset();
    $limit = 200 if $limit > 200; # Safety limit

    my $perms = $self->{ctrl}->perms($category_id);
    my $navbar = $self->navbar($category_id);
    my $link_db = $DB->table('Links');
    my $in = $IN->get_hash();

# Get the category ids that the search will be done on. 

# Do the search and count the results.
    $in->{"CatLinks.CategoryID"} = "";
    if ($in->{in_category}) {
        $in->{"CatLinks.CategoryID"} = $in->{in_category};
    }
    elsif (!$self->{ctrl}->admin) {
        my $cats = $self->{ctrl}->user_base_node;

# The user is allowed to access user_base_node categories and their children.
        my $children = $DB->table('Category')->children($cats);
        for (keys %$children) {
            push @$cats, @{$children->{$_}};
        }

        $in->{"CatLinks.CategoryID"} = $cats;
    }
    my $sth = $link_db->query_sth($in);
    my $count = $link_db->hits();

    if ($count == 0) {
        return $self->link_search_form(Links::language('BROWSER_NOSEARCH'));
    }

# Generate toolbar.
    my $tb;
    if ($count > $limit) {
        my $cgi = new GT::CGI;
        $cgi->param('action', 'link_search_results');
        $cgi->param('category_id', $category_id);
        $tb = $DB->html($link_db, $IN)->toolbar($page, $limit, $count, $cgi->url);
    }

# Get list of links that have changes.
    my $ids = $sth->fetchall_arrayref;
    my %changed;
    my @ids = map {$_->[0]} @$ids;
    my $sth2 = $change_db->select({LinkID => \@ids});
    while (my ($id) = $sth2->fetchrow_array) {
        $changed{$id} = 1;
    }

# Now get the actual link information.
    $sth = $link_db->query_sth($in);

# Get list of links.
    my @links;
    my $c_table = $DB->table('CatLinks');
    while (my $link = $sth->fetchrow_hashref) {
        $link->{CategoryID} ||= $c_table->select(['CategoryID'],{LinkID => $link->{ID}})->fetchrow_array();
        push (@links,{
                                      category_id      => $category_id,
                                      hasChangeRequest => $changed{$link->{ID}} || 0,
                                      linkowner_esc    => GT::CGI->escape($link->{LinkOwner}),
                                      %$link,
                                      %$perms,
# $perms can contain the CategoryID (for editor's), which breaks deletion, so
# make sure we override it
                                      CategoryID => $link->{CategoryID},
                                  }
            );
    }
    my $info = { toolbar => $tb, count => $count, navbar => $navbar, links => \@links};
    $self->print_template('browser_link_search_results.html',$info);

}
END_OF_SUB

# -------------------------------------------------------------------------------------- #
# Private Functions                                                                      #
# -------------------------------------------------------------------------------------- #

sub _build_category_id_set {
# -------------------------------------------------------------------
# returns a set of category ids when updating
#
    my ($self, $linkid, $remove, $add) = @_;

    my %res;
    my $catlinks = $DB->table (qw /CatLinks/);
    my $sth = $catlinks->select ( { LinkID => $linkid } );
    while (my $h = $sth->fetchrow_hashref) {
        $res{$h->{CategoryID}} = 1;
    }

    delete $res{$remove} if $remove;
    $res{$add} = 1 if $add;

    return wantarray ? keys %res : [ keys %res ];
}

sub _links_list_html {
# -------------------------------------------------------------------
# build an HTML list of all the links in a given category
#
    my ($self, $category_id, $username) = @_;
    my $change_db      = $DB->table('Changes');

    my ($limit, $offset, $page) = Links::limit_offset();
    $limit = 200 if $limit > 200; # Safety limit

    my $perms          = $self->{ctrl}->perms($category_id);
    my ($link_db, $catlink_db, $sth, $count, $tb);

# Select list of ID's.
    $link_db = $DB->table('Links');
    if ($username) {
        $link_db->select_options("LIMIT $limit OFFSET $offset");
        $sth        = $link_db->select('ID', { LinkOwner => $username }) or die "Database error: $GT::SQL::error";
        $count      = $link_db->hits;
    }
    else {
        $catlink_db = $DB->table('CatLinks', 'Links');
        $catlink_db->select_options("ORDER BY $CFG->{build_sort_order_editor}", "LIMIT $limit OFFSET $offset");
        $sth   = $catlink_db->select('ID', { CategoryID => $category_id }) or die "Database error: $GT::SQL::error";
        $count = $catlink_db->hits;
    }

    if ($count == 0) {
        my $info = { toolbar => '', links => '', count => $count };
        return wantarray ? %$info : $info;
    }

# Get list of links that have changes.
    my @ids = $sth->fetchall_list;
    my %changed;
    my $sth2 = $change_db->select({ LinkID => \@ids });
    while (my ($id) = $sth2->fetchrow_array) {
        $changed{$id} = 1;
    }

# Generate toolbar.
    if ($count > $limit) {
        my $cgi = new GT::CGI;

# Get the base URL for the toolbar
        my @query_elements;

        if ($username) {
            push @query_elements, (
                [ action => 'link_user_list' ],
                [ user => $username ]
            )

        }
        else {
            push @query_elements, (
                [ action => 'category_click' ]
            );
        }
        push @query_elements, [ category_id => $category_id ];

        my $url = '';

        my $script = $ENV{SCRIPT_NAME} || $0;
        my ($path, $prog) = $script =~ m,^(.+?)[/\\]?([^/\\]*)$,;
        $prog =~ s,^[/\\]*|[/\\]*$,,g;
        $url .= $prog;
        if ( $ENV{PATH_INFO}) {
            if (defined $ENV{SERVER_SOFTWARE} && ($ENV{SERVER_SOFTWARE} =~ /IIS/)) {
                $ENV{PATH_INFO} =~ s,$ENV{SCRIPT_NAME},,;
            }
            $url .= $ENV{PATH_INFO};
        }

        foreach my $p (qw( mh nh )) {
            next unless my $v = $IN->param( $p );
            push @query_elements, [
                $p => $v
            ];
        }

        my @query_parameters;
        foreach my $p ( @query_elements ) {
            push @query_parameters, $IN->escape( $p->[0] ) . '=' . $IN->escape( $p->[1] );
        }

        $url .= '?' . join "&", @query_parameters if @query_parameters;

# create the toolbar html
        $tb = $DB->html($link_db || $catlink_db, $IN)->toolbar($page, $limit, $count, $url );
    }

# Now get the actual link information.
    $sth = $link_db->select({ ID => \@ids });

# Get list of links.
    my %output;
    while (my $link = $sth->fetchrow_hashref) {
        $output{$link->{ID}} = $self->return_template("browser_link_list.html",
        {
            category_id      => $category_id,
            hasChangeRequest => $changed{$link->{ID}} || 0,
            hasReviews       => $perms->{CanModReview} eq 'Yes' ? $DB->table('Reviews')->count({ Review_LinkID => $link->{ID} }) : 0,
            linkowner_esc    => GT::CGI->escape($link->{LinkOwner}),
            %$link,
            %$perms
        }
    );
    }
    my $output = join("\n", map { $output{$_} } @ids);
    my $info = { toolbar => $tb, links => $output, count => $count };
    return wantarray ? %$info : $info;
}

sub navbar {
# -------------------------------------------------------------------
# Prints out the navbar.
#
    my ($self, $category_id) = @_;
    my $perms = $self->{ctrl}->perms ($category_id);

    if ($CFG->{payment}->{enabled} and $category_id) {
        my $mode = $DB->table('Category')->select('Payment_Mode', { ID => $category_id })->fetchrow();
        if ($mode >= OPTIONAL) { # REQUIRED is > OPTIONAL
            $perms->{CanAddTerms} = 'Yes';
        }
    }

    return $self->return_template ('browser_navbar.html', { category_id => $category_id, %$perms });
}

sub javascript_error {
# -------------------------------------------------------------------
# prints out an alert windows with the error information
#
    my $self = shift;
    my $args;
    if (@_ == 1 and $_[0] eq ref {}) { $args = shift  }
    else                             { $args = { @_ } }

    my @err = (qq /=============================================/,
               Links::language('GENERAL_ERROR'),
               qq /=============================================/,
               qq / /);

    push @err, $args->{message} if ($args->{message});

    foreach (@err) {
        s/\\/\\\\/g;
        s/\n/\\n/g;
        s/'/\\'/g;
        s/"/\\"/g;
    }

    my $error = 'alert (';
    $error .= join '+ "\n" +', map { '"' . $_ . '"' } @err;
    $error .= ');';

    if ($args->{info_go}) {
        $error .= qq|parent.frames[parent.RIGHT_FRAME_ID].history.go($args->{info_go});\n|;
    }
    if ($args->{tree_go}) {
        $error .= qq|parent.frames[parent.LEFT_FRAME_ID].history.go($args->{tree_go});\n|;
    }
    if ($args->{hist_go}) {
        $error .= qq|history.go($args->{hist_go});\n|;
    }
    if ($args->{tree_redraw}) {
        require Links::Browser::JFunction;
        $error .= qq|parent.draw_tree(); parent.frames[parent.RIGHT_FRAME_ID].location.replace("| . Links::Browser::JFunction::tree_selectnode() . qq|&category_id=$args->{tree_redraw}");\n|;
    }

    return $self->print_template('browser_javascript_error.html', { error => $error });
}

sub _format_js {
# -------------------------------------------------------------------
# Format a string into something Javascript will like.
#
    my $string = shift;
    my @tmp = split /\n/, $string;
    my $output = "\n";
    foreach (@tmp) {
        $output .= " + $_ \n" if (defined $_);
    }
    return $output;
}

sub _total_categories {
# -------------------------------------------------------------------
# returns the amount of categories that is being managed
# by the current user.
#
    my $self      = shift;
    my $category  = $DB->table ('Category');

    return $category->count;
}

sub _quote {
# -------------------------------------------------------------------
# Escapes text for use in javascript.
#
    my $text = shift;
    return '""' if (! defined $text or ($text eq ''));
    $text =~ s/"/\\"/g;
    $text =~ s/\r//g;
    $text =~ s/\n/\\n/g;
    $text =~ s,<\s*/script\s*>,</scr" + "ipt>,g;
    return '"' . $text . '"';
}

sub _format_insert_cgi {
# -------------------------------------------------------------------
# Fix things with cgi on inserts/modify (similar to
# GT::SQL::Admin::format_insert_cgi).  Unchecked checkboxes don't return
# anything, so the value needs to be set to an empty string.
#
    my ($cgi, $table) = @_;

    my $cols = $table->cols;
    foreach (keys %$cols) {
        $cgi->{$_} = '' if !exists $cgi->{$_} and uc $cols->{$_}->{form_type} eq 'CHECKBOX';
    }
}

1;
