saint/discourse-legacysite-perl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
08eb7b7da2
discourse-legacysite-perl/site/slowtwitch.com/cgi-bin/articles/admin/Links/Browser.pm
dsainty aa25e9347f First pass at adding key files
2024-06-17 21:49:12 +10:00

2370 lines
99 KiB
Perl
Raw Blame History

# ==================================================================
# 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;
Reference in New Issue View Git Blame Copy Permalink