saint/discourse-legacysite-perl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

First pass at adding key files

Browse Source
This commit is contained in:
dsainty
2024-06-17 21:49:12 +10:00
commit aa25e9347f
1274 changed files with 392549 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

303
site/slowtwitch.com/cgi-bin/articles/admin/Links/User/Add.pm Normal file
View File

@ -0,0 +1,303 @@
# ==================================================================
# 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: Add.pm,v 1.59 2007/12/20 20:31:35 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::User::Add;
# ==================================================================
use strict;
use Links qw/:objects :payment/;
use Links::Build;
use Links::SiteHTML;
sub handle {
# -------------------------------------------------------------------
# Display either an add form or process an add request.
#
if ($CFG->{user_required} and !$USER) {
print $IN->redirect(Links::redirect_login_url('add'));
return;
}
my $custom;
if (exists $CFG->{payment}->{remote}->{used}->{PayPal} and $custom = $IN->param('custom') and substr($custom, 0, 3) eq 'do;') {
substr($custom, 0, 3) = '';
my @pairs = split /;/, $custom;
for (@pairs) {
my ($key, $val) = split /=/, $_;
next unless $key and $val;
$IN->param($key => $val) unless $IN->param($key);
}
}
print $IN->header;
# We are processing an add request.
if ($IN->param('add')) {
my $results = $PLG->dispatch('user_add_link', \&add_link);
if (defined $results->{error}) {
print Links::SiteHTML::display('add', $results);
}
else {
$results = Links::SiteHTML::tags('link', $results);
$results->{main_title_loop} = Links::Build::build('title', Links::language('LINKS_ADD_SUCCESS'), "$CFG->{db_cgi_url}/add.cgi");
if ($CFG->{payment}->{enabled}) {
require Links::Payment;
my @cats = $IN->param('CatLinks.CategoryID');
my $opt = Links::Payment::load_cat_price(\@cats);
if (exists $opt->{error}) {
print Links::SiteHTML::display('error', $opt);
}
elsif ($opt->{payment_mode} == NOT_ACCEPTED) {
if ($CFG->{admin_email_add}) {
Links::send_email('link_added.eml', $results, { admin_email => 1 }) or die "Unable to send mail: $GT::Mail::error";
}
print Links::SiteHTML::display('add_success', $results);
}
else {# payment option for this category is required or optional
$results->{link_id} = $results->{ID}; # we need a different tag since both Category and Link have ID
$opt->{CategoryID} = delete $opt->{ID}; # remove category id
$opt->{CategoryDescription} = delete $opt->{Description};
$results->{main_title_loop} = Links::Build::build('title', Links::language('LINKS_PAYMENT'), "$CFG->{db_cgi_url}/modify.cgi?do=payment_linked;process_payment=1;modify=1;ID=$results->{link_id}");
print Links::SiteHTML::display('payment', { %$results, %$opt });
}
}
else {
if ($CFG->{admin_email_add}) {
Links::send_email('link_added.eml', $results, { admin_email => 1 }) or die "Unable to send mail: $GT::Mail::error";
}
print Links::SiteHTML::display('add_success', $results);
}
}
}
# We are processing a payment request.
elsif ($IN->param('process_payment') and $CFG->{payment}->{enabled}) {
my $payment_term = $IN->param('payment_term') || '';
my $do = $IN->param('do');
if ($payment_term eq 'free') {
my $link = $DB->table('Links')->get($IN->param('link_id'));
if (not $link or ($CFG->{user_required} and $link->{LinkOwner} ne $USER->{Username})) {
print Links::SiteHTML::display('error', { error => !$link ? $GT::SQL::ERRORS : Links::language('PAYMENTERR_NOTOWNER') });
return;
};
$link = Links::SiteHTML::tags('link', $link);
# Set ExpiryDate to free
$link->{'CatLinks.CategoryID'} = $IN->param('cat_id');
$link->{ExpiryDate} = FREE;
$link->{ExpiryNotify}= 0;
# Update the link
$DB->table('Links')->update({ ExpiryDate => FREE, ExpiryNotify => 0 }, { ID => $link->{ID} });
# Update the Timestmp for link's categories so they get rebuilt with build changed
my @cats = $DB->table('Links', 'CatLinks')->select('CategoryID', { LinkID => $link->{ID} })->fetchall_list;
$DB->table('Category')->update({ Timestmp => \'NOW()' }, { ID => \@cats });
# Add some special tags for formatting.
@cats = $DB->table('Category', 'CatLinks')->select('Category.Full_Name', { 'CatLinks.LinkID' => $link->{ID} })->fetchall_list;
$link->{Category} = join "\n", sort @cats;
$link->{Category_loop} = [sort @cats];
$link->{Host} = $ENV{REMOTE_HOST} ? "$ENV{REMOTE_HOST} ($ENV{REMOTE_ADDR})" : $ENV{REMOTE_ADDR} ? $ENV{REMOTE_ADDR} : 'none';
$link->{Referer} = $ENV{HTTP_REFERER} ? $ENV{HTTP_REFERER} : 'none';
$link->{AutoValidate} = $CFG->{build_auto_validate};
if ($CFG->{admin_email_add}) {
Links::send_email('link_added.eml', $link, { admin_email => 1 }) or die "Unable to send mail: $GT::Mail::error";
}
$link->{main_title_loop} = Links::Build::build('title', Links::language('LINKS_ADD_SUCCESS'), "$CFG->{db_cgi_url}/add.cgi");
print Links::SiteHTML::display('add_success', $link);
}
elsif ($IN->param('payment_success')) {
print Links::SiteHTML::display('payment_success', { main_title_loop => Links::Build::build('title', Links::language('LINKS_PAYMENT_SUCCESS'), $CFG->{build_root_url} . "/" . ($CFG->{build_home} || ($CFG->{build_index_include} ? $CFG->{build_index} : ''))) });
}
elsif ($do =~ /^payment_(method|form|direct)$/) {
require Links::Payment;
my $vars = Links::Payment->$1();
my $page = $IN->param('page') || $IN->param('do');
my $opt = Links::Payment::load_cat_price($IN->param('cat_id'));
if ($opt->{payment_mode} == NOT_ACCEPTED) {
print Links::SiteHTML::display('error', { error => Links::language('PAYMENTERR_NOTACCEPTED') });
return;
}
my $link = $DB->table('Links')->get($IN->param('link_id'));
if (not $link or ($CFG->{user_required} and $link->{LinkOwner} ne $USER->{Username})) {
print Links::SiteHTML::display('error', { error => !$link ? $GT::SQL::ERRORS : Links::language('PAYMENTERR_NOTOWNER') });
return;
}
$link = Links::SiteHTML::tags('link', $link);
$link->{main_title_loop} = Links::Build::build('title', Links::language('LINKS_PAYMENT'), "$CFG->{db_cgi_url}/modify.cgi?do=payment_linked;process_payment=1;modify=1;ID=$link->{ID}");
print Links::SiteHTML::display($page, { %$vars, %$opt, %$link });
}
else {
print Links::SiteHTML::display('error', { error => "Invalid action" });
}
}
# We are displaying an add form.
else {
my @id = grep { /^\d+$/ } $IN->param('ID');
# If we don't have an id, and can't generate a list, let's send the user a message.
if (!@id and !$CFG->{db_gen_category_list}) {
print Links::SiteHTML::display('error', { error => Links::language('ADD_SELCAT') });
}
else {
# Otherwise display the add form.
if ($USER) {
$IN->param('Contact_Name') or ($IN->param('Contact_Name', $USER->{Name} || $USER->{Username}));
$IN->param('Contact_Email') or ($IN->param('Contact_Email', $USER->{Email}));
}
if ($DB->table('Category')->count == 0) {
print Links::SiteHTML::display('error', { error => Links::language('ADD_NOCATEGORIES') });
}
# If we're not generating a category list, the add form can't be shown without a valid category ID.
elsif (!$CFG->{db_gen_category_list} and $DB->table('Category')->count({ ID => \@id }) == 0) {
print Links::SiteHTML::display('error', { error => Links::language('ADD_INVALIDCAT', join(', ', @id)) });
}
else {
my $category = {};
if ($CFG->{db_gen_category_list} < 2) {
require Links::Tools;
$category = Links::Tools::category_list();
$category->{Category} = sub { Links::Tools::category_list_html() };
}
print Links::SiteHTML::display('add', {
main_title_loop => Links::Build::build('title', Links::language('LINKS_ADD'), "$CFG->{db_cgi_url}/add.cgi" . (@id ? "?ID=" . join(';ID=', @id) : '')),
%$category
});
}
}
}
}
sub add_link {
# --------------------------------------------------------
# Add the link to the database.
#
my $class = shift;
my @id = $IN->param('CatLinks.CategoryID');
my %ret;
if ($CFG->{db_gen_category_list} < 2) {
require Links::Tools;
%ret = %{Links::Tools::category_list()};
$ret{Category} = sub { Links::Tools::category_list_html() };
}
$ret{main_title_loop} = Links::Build::build('title', Links::language('LINKS_ADD'), "$CFG->{db_cgi_url}/add.cgi" . (@id ? "?ID=" . join(';ID=', @id) : ''));
# Check the referer.
if (@{$CFG->{db_referers}}) {
my $found = 0;
if ($ENV{'HTTP_REFERER'}) {
foreach (@{$CFG->{db_referers}}) { $ENV{'HTTP_REFERER'} =~ /\Q$_\E/i and $found++ and last; }
}
unless ($found) {
return { error => Links::language('ADD_BADREFER', $ENV{'HTTP_REFERER'}), %ret };
}
}
# Get our form data.
my $input = $IN->get_hash;
# Check if the link is valid
if ($CFG->{user_link_validation}) {
require Links::Tools;
my $status = Links::Tools::link_status($input->{URL});
if ($status and $Links::Tools::STATUS_BAD{$status}) {
return { error => Links::language('ADD_BADSTATUS', $Links::Tools::STATUS_BAD{$status}), %ret };
}
}
my $db = $DB->table('Links');
my $cdb = $DB->table('Category');
# Columns the user should not be passing in
for my $key (qw/ID LinkOwner Add_Date Mod_Date Timestmp Date_Checked ExpiryDate ExpiryCounted ExpiryNotify LinkExpired/) {
delete $input->{$key};
}
for my $key (keys %{$CFG->{add_system_fields}}) {
$input->{$key} = $CFG->{add_system_fields}->{$key};
}
# Set the LinkOwner
$input->{LinkOwner} = $USER ? $USER->{Username} : 'admin';
# Set date variable to today's date.
Links::init_date();
my $today = GT::Date::date_get();
$input->{Add_Date} = $today;
$input->{Mod_Date} = $today;
# Backward compatibility
$input->{Contact_Name} = $input->{'Contact_Name'} || $input->{'Contact Name'} || ($USER ? $USER->{Name} : '');
$input->{Contact_Email} = $input->{'Contact_Email'} || $input->{'Contact Email'} || ($USER ? $USER->{Email} : '');
$input->{isValidated} = ($CFG->{build_auto_validate} == 1 and $USER or $CFG->{build_auto_validate} == 2) ? 'Yes' : 'No';
# Check the category
my @cids = $IN->param('CatLinks.CategoryID');
my @name;
if (@cids) {
foreach my $cid (@cids) {
next if (! $cid);
my $sth = $cdb->select('Full_Name', { ID => $cid });
$sth->rows or return { error => Links::language('ADD_INVALIDCAT', $cid), %ret };
push @name, $sth->fetchrow;
}
if (@name) {
$input->{'CatLinks.CategoryID'} = \@cids;
}
}
my $take_payments = (
$CFG->{payment}->{enabled}
and
(
$cdb->count(GT::SQL::Condition->new(Payment_Mode => '>=' => OPTIONAL, ID => '=' => \@cids))
or
(
$CFG->{payment}->{mode} >= OPTIONAL and
$cdb->count(GT::SQL::Condition->new(Payment_Mode => '=' => GLOBAL, ID => '=' => \@cids))
)
)
);
# Set the payment expiry
# Set this to unlimited when payment is turned off so that if payment is turned on
# at a later date, those users aren't forced to pay.
$input->{ExpiryDate} = $CFG->{payment}->{enabled} && $take_payments ? UNPAID : FREE;
# Setup the language for GT::SQL.
local $GT::SQL::ERRORS->{ILLEGALVAL} = Links::language('ADD_ILLEGALVAL');
local $GT::SQL::ERRORS->{UNIQUE} = Links::language('ADD_UNIQUE');
local $GT::SQL::ERRORS->{NOTNULL} = Links::language('ADD_NOTNULL');
local $Links::Table::Links::ERRORS->{NOCATEGORY} = Links::language('ADD_NOCATEGORY');
$Links::Table::Links::ERRORS if 0; # silence -w
# Add the record.
my $id = $db->add($input);
$input->{ID} = $id;
if (! $id) {
my $error = "<ul>" . join('', map "<li>$_</li>", $db->error) . "</ul>";
return { error => $error, %ret };
}
# Add some special tags for formatting.
$input->{Category} = join "\n", sort @name;
$input->{Category_loop} = [sort @name];
$input->{Host} = $ENV{REMOTE_HOST} ? "$ENV{REMOTE_HOST} ($ENV{REMOTE_ADDR})" : $ENV{REMOTE_ADDR} ? $ENV{REMOTE_ADDR} : 'none';
$input->{Referer} = $ENV{HTTP_REFERER} ? $ENV{HTTP_REFERER} : 'none';
$input->{AutoValidate} = $CFG->{build_auto_validate};
# Send the visitor to the success page.
return $input;
}
1;

126
site/slowtwitch.com/cgi-bin/articles/admin/Links/User/Editor.pm Normal file
View File

@ -0,0 +1,126 @@
# ==================================================================
# 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: Editor.pm,v 1.15 2009/05/09 06:40:54 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::User::Editor;
# ==================================================================
use strict;
use Links qw/:objects/;
use Links::Browser::Controller;
use Links::Browser;
use Links::SiteHTML;
sub handle {
# ------------------------------------------------------------------
# This script is only available to users who have logged on.
#
unless ($USER) {
my $url = $IN->url(absolute => 1, query_string => 1);
$url = $IN->escape($url);
$url = $CFG->{db_cgi_url} . "/user.cgi?url=$url;from=browser";
print $IN->redirect($url);
return;
}
my $editors = $DB->table('Editors');
my @nodes;
my $perms = {};
# Get a controller to manage access.
my $ctrl = Links::Browser::Controller->new(user => $USER);
if ($USER->{Status} eq 'Administrator') {
$ctrl->{admin} = 1;
}
else {
my $sth = $editors->select({ Username => $USER->{Username} });
if ($sth->rows) {
while (my $ed = $sth->fetchrow_hashref) {
push @nodes, $ed->{CategoryID};
$perms->{$ed->{CategoryID}} = $ed;
}
}
unless (@nodes) {
print $IN->header;
print Links::SiteHTML::display('error', { error => Links::language('BROWSER_NOTEDITOR') });
return;
}
}
# Handle the special condition which related to viewing
# and downloading files. Must remap the passed column
# values so Jump functions properly.
my $method = $IN->param('do');
if ($method and $method =~ m/^(?:(v)iew|(download))_file$/) {
$IN->param($+, $IN->param('cn'));
$IN->param('ID', $IN->param('link_id') || $IN->param('id'));
$IN->param('DB', $IN->param('db'));
require Links::User::Jump;
return Links::User::Jump::handle();
}
elsif ($method and $method =~ m/^(?:(v)iew|(download))_tmp_file$/) {
my $download = $2;
# view_tmp_file doesn't go through Jump because only editors are
# allowed to see them - the tmp files are used for pending Changes.
my $col = $IN->param('cn');
my $id = $IN->param('link_id');
my $changes = $DB->table('Changes')->select({ LinkID => $id })->fetchrow_hashref;
my ($linkinfo, $fh);
if ($changes) {
$linkinfo = eval $changes->{ChgRequest};
if ($linkinfo and -f $linkinfo->{$col}) {
my $colfh = \do { local *FH; *FH };
if (open $colfh, "<$linkinfo->{$col}") {
$fh = $colfh;
binmode $fh;
}
}
}
if (!$fh) {
print $IN->header();
print Links::SiteHTML::display('error', { error => Links::language('FILE_UNKNOWN', $id) });
return;
}
(my $filename = $linkinfo->{"${col}_filename"} || $linkinfo->{$col}) =~ s{.*[/\\]}{};
print $IN->header($IN->file_headers(
filename => $filename,
inline => $download ? 0 : 1,
size => -s $linkinfo->{$col}
));
while (read $fh, my $buffer, 64*1024) {
print $buffer;
}
return 1;
}
# Load the tree if it is under 200 categories.
$ctrl->{load_tree} = 1;
$ctrl->{user_base_node} = \@nodes;
$ctrl->{perms} = $perms;
$ctrl->{admin_templates} = 0;
# Begin the script.
print $IN->header(-charset => $CFG->{header_charset});
$method = $ctrl->can_run;
if ($method) {
my $browser = Links::Browser->new(ctrl => $ctrl);
$PLG->dispatch("browser_$method", sub { $browser->$method(); }, $browser);
}
else {
print Links::SiteHTML::display('error', { error => Links::language('BROWSER_UNAUTHORIZED') });
}
}
1;

186
site/slowtwitch.com/cgi-bin/articles/admin/Links/User/Jump.pm Normal file
View File

@ -0,0 +1,186 @@
# ==================================================================
# 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: Jump.pm,v 1.26 2006/02/20 22:38:31 jagerman 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::User::Jump;
# ==================================================================
use strict;
use Links qw/:objects :payment/;
use Links::SiteHTML;
sub handle {
# --------------------------------------------------------------
# Jump to a given ID.
#
$PLG->dispatch('jump_link', \&_plg_jump, {});
}
sub _plg_jump {
# --------------------------------------------------------------
# Jump to a given link.
#
my $links = $DB->table('Links');
my $id = $IN->param('ID') || $IN->param('Detailed');
my $action = $IN->param('action') || '';
my $goto = '';
my $rec = {};
if ($CFG->{framed_jump} and $id and $action eq 'jump_frame') {
my $error;
if ($id !~ /^\d+$/) {
$error = Links::language('JUMP_INVALIDID', $id);
}
else {
$rec = $links->select({ ID => $id }, VIEWABLE)->fetchrow_hashref;
unless ($rec) {
$error = Links::language('JUMP_INVALIDID', $id);
$rec = {};
}
elsif ($CFG->{build_detailed}) {
$rec->{detailed_url} = "$CFG->{build_detail_url}/" . $links->detailed_url($id);
}
}
print $IN->header();
print Links::SiteHTML::display('jump_frame', { error => $error, %$rec });
return;
}
# If we are chosing a random link, then get the total and go to one at random.
if (lc $id eq "random") {
my $offset = int rand $links->count(VIEWABLE);
$links->select_options("LIMIT 1 OFFSET $offset");
my $sth = $links->select(qw/ID URL/ => VIEWABLE);
($id, $goto) = $sth->fetchrow_array;
}
elsif (defined $id) {
if ($id !~ /^\d+$/) {
print $IN->header();
print Links::SiteHTML::display('error', { error => Links::language('JUMP_INVALIDID', $id) });
return;
}
# Find out if we're going to be displaying a file
my $col = $IN->param('v') || $IN->param('dl') || $IN->param('view') || $IN->param('download');
if ($col) {
# in this case, we need to know from what table we want to load our data from.
# It will by default pull information from the Links table, however if the
# DB=tablename option is used, it will apply the request to that table instead
my $table_name = $IN->param('DB') || 'Links';
unless ($table_name =~ m/^\w+$/) {
print $IN->header();
print Links::SiteHTML::display('error', { error => Links::language('FILE_TABLEFORMAT' ) });
return;
};
if ($table_name ne 'Links') {
eval { $links = $DB->table($table_name) };
if ($@) {
print $IN->header();
print Links::SiteHTML::display('error', { error => Links::language('FILE_TABLE', $table_name, $GT::SQL::error) });
return;
}
}
my $fh;
eval { $fh = $links->file_info($col, $id); };
if ($fh) {
if ($IN->param('v') or $IN->param('view')) { # Viewing
print $IN->header($IN->file_headers(
filename => $fh->File_Name,
mimetype => $fh->File_MimeType,
inline => 1,
size => $fh->File_Size
));
}
else { # Downloading
print $IN->header($IN->file_headers(
filename => $fh->File_Name,
mimetype => $fh->File_MimeType,
inline => 0,
size => $fh->File_Size
));
}
binmode $fh;
while (read($fh, my $buffer, 65536)) {
print $buffer;
}
return 1;
}
else {
print $IN->header();
print Links::SiteHTML::display('error', { error => Links::language('FILE_UNKNOWN', $id) });
return;
}
}
# Jump to a URL, bump the hit counter.
else {
$rec = $links->select({ ID => $id }, VIEWABLE)->fetchrow_hashref;
unless ($rec) {
print $IN->header();
print Links::SiteHTML::display('error', { error => Links::language('JUMP_INVALIDID', $id) });
return;
}
$goto = $rec->{URL};
my $clicktrack = $DB->table('ClickTrack');
my $rows = $clicktrack->count({ LinkID => $id, IP => $ENV{REMOTE_ADDR}, ClickType => 'Hits' });
unless ($rows) {
eval {
$clicktrack->insert({ LinkID => $id, IP => $ENV{REMOTE_ADDR}, ClickType => 'Hits', Created => \"NOW()" });
$links->update({ Hits => \"Hits + 1" }, { ID => $id }, { GT_SQL_SKIP_INDEX => 1 });
};
}
}
}
# Oops, no link.
else {
print $IN->header();
print Links::SiteHTML::display('error', { error => Links::language('JUMP_INVALIDID', $id) });
return;
}
unless (defined $goto) {
my $error = ($IN->param('ID') eq 'random') ? Links::language('RANDOM_NOLINKS') : Links::language('JUMP_INVALIDID', $id);
print $IN->header();
print Links::SiteHTML::display('error', { error => $error });
return;
}
# Redirect to a detailed page if requested.
if ($CFG->{build_detailed} and $IN->param('Detailed')) {
$goto = Links::transform_url("$CFG->{build_detail_url}/" . $links->detailed_url($id));
}
($goto =~ m,^\w+://,) or ($goto = "http://$goto");
if ($goto) {
if ($CFG->{framed_jump} and not ($CFG->{build_detailed} and $IN->param('Detailed'))) {
unless (keys %$rec) {
$rec = $links->select({ ID => $id }, VIEWABLE)->fetchrow_hashref;
}
$rec->{detailed_url} = "$CFG->{build_detail_url}/" . $links->detailed_url($id) if $CFG->{build_detailed};
print $IN->header();
print Links::SiteHTML::display('jump', { destination => $goto, %$rec });
return;
}
else {
print $IN->redirect($goto);
}
}
else {
print $IN->header();
print Links::SiteHTML::display('error', { error => Links::language('JUMP_INVALIDID', $id) });
return;
}
}
1;

263
site/slowtwitch.com/cgi-bin/articles/admin/Links/User/Login.pm Normal file
View File

@ -0,0 +1,263 @@
# ==================================================================
# 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: Login.pm,v 1.19 2005/05/08 09:56:44 brewt Exp $
#
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
# Redistribution in part or in whole strictly prohibited. Please
# see LICENSE file for full details.
# ==================================================================
package Links::User::Login;
# ==================================================================
use strict;
use Links qw/:objects/;
use Links::Build;
use Links::SiteHTML;
sub handle {
# -------------------------------------------------------------------
# Determine what to do.
#
my $input = $IN->get_hash;
my $mtl = Links::Build::build('title', Links::language('LINKS_LOGIN'), "$CFG->{db_cgi_url}/user.cgi");
if ($input->{login}) {
$PLG->dispatch('user_login', \&login_user);
}
elsif ($input->{signup_user}) {
$PLG->dispatch('user_signup', \&signup_user);
}
elsif ($input->{validate_user}) {
$PLG->dispatch('user_validate', \&validate_user);
}
elsif ($input->{send_validate}) {
$PLG->dispatch('user_validate_email', \&send_validate);
}
elsif ($input->{send_pass} and $CFG->{user_allow_pass}) {
$PLG->dispatch('user_pass_email', \&send_pass);
}
elsif ($input->{signup_form}) {
print $IN->header();
print Links::SiteHTML::display('signup_form', { Username => $IN->param('Username') || '', Password => '', Email => $IN->param('Email') || '', main_title_loop => Links::Build::build('title', Links::language('LINKS_SIGNUP'), "$CFG->{db_cgi_url}/user.cgi?signup_form=1") });
}
elsif ($input->{validate}) {
print $IN->header();
print Links::SiteHTML::display('validate_form', { main_title_loop => Links::Build::build('title', Links::language('LINKS_VALIDATE'), "$CFG->{db_cgi_url}/user.cgi?validate=1") });
}
elsif ($input->{logout}) {
Links::Authenticate::auth('delete_session');
$USER = undef;
print $IN->header();
print Links::SiteHTML::display('login', { Username => '', Password => '', Email => '', error => Links::language('USER_LOGOUT'), main_title_loop => $mtl });
}
elsif ($input->{email_pass} and $CFG->{user_allow_pass}) {
print $IN->header();
print Links::SiteHTML::display('login_email', { main_title_loop => Links::Build::build('title', Links::language('LINKS_EMAILPASS'), "$CFG->{db_cgi_url}/user.cgi?email_pass=1") });
}
else {
print $IN->header();
print Links::SiteHTML::display('login', { Username => $IN->param('Username') || '', main_title_loop => $mtl });
}
}
# ==============================================================
sub login_user {
# --------------------------------------------------------
# Logs a user in, and creates a session ID.
#
my $username = $IN->param('Username') || shift;
my $password = $IN->param('Password') || shift;
my $goto = shift || 'login_success';
my $mtl = Links::Build::build('title', Links::language('LINKS_LOGIN'), "$CFG->{db_cgi_url}/user.cgi");
# Make sure we have both a username and password.
if (!$username or !$password) {
print $IN->header();
print Links::SiteHTML::display('login', { error => Links::language('USER_BADLOGIN'), Username => $username, main_title_loop => $mtl });
return;
}
# Check that the user exists, and that the password is valid.
my $user = Links::init_user($username, $password);
if (!$user) {
print $IN->header();
require Links::Authenticate;
if (Links::Authenticate::auth_valid_user({ Username => $username, Password => $password })) {
print Links::SiteHTML::display('login', { error => Links::language('USER_NOTVAL', $user->{Email}), Username => $user->{Username}, main_title_loop => $mtl });
}
else {
print Links::SiteHTML::display('login', { error => Links::language('USER_BADLOGIN'), main_title_loop => $mtl });
}
return;
}
# Store the session in either a cookie or url based.
my $results = Links::Authenticate::auth('create_session', { Username => $user->{Username} });
return if $results->{redirect};
# Get the $USER information.
$USER = Links::Authenticate::auth('get_user', { Username => $username, Password => $password, auto_create => 1 });
print $IN->header(); # In case the session didn't print it.
print Links::SiteHTML::display($goto, { %$user, main_title_loop => $mtl });
}
sub signup_user {
# --------------------------------------------------------
# Signs a new user up.
#
my $username = $IN->param('Username');
my $password = $IN->param('Password');
my $email = $IN->param('Email');
my $mtl = Links::Build::build('title', Links::language('LINKS_SIGNUP'), "$CFG->{db_cgi_url}/user.cgi?signup_form=1");
if (!$username or !$password or !$email) {
print $IN->header();
print Links::SiteHTML::display('signup_form', { error => Links::language('USER_INVALIDSIGNUP'), main_title_loop => $mtl });
return;
}
unless ($email =~ /.\@.+\../) {
print $IN->header();
print Links::SiteHTML::display('signup_form', { error => Links::language('USER_INVALIDEMAIL', $email), main_title_loop => $mtl });
return;
}
# Check that the username doesn't already exist.
my $db = $DB->table('Users');
my $user = $db->get($username);
if ($user) {
print $IN->header();
print Links::SiteHTML::display( 'signup_form', { error => Links::language('USER_NAMETAKEN', $username), main_title_loop => $mtl });
return;
}
# Check that the email address doesn't already exist.
my $hits = $db->count({ Email => $email });
if ($hits) {
print $IN->header();
print Links::SiteHTML::display('signup_form', { error => Links::language('USER_EMAILTAKEN', $email), main_title_loop => $mtl });
return;
}
my ($code, $msg);
# Add the user in, set defaults for fields not specified.
$user = $IN->get_hash();
my $def = $db->default || {};
foreach (keys %$def) {
$user->{$_} = $def->{$_} unless (exists $user->{$_});
}
# Send validation email if needed.
if ($CFG->{user_validation}) {
my $code = time . $$ . int rand 1000;
$user->{Status} = "Not Validated";
$user->{Validation} = $code;
my $ret = $db->add($user);
if (!$ret) {
print $IN->header();
print Links::SiteHTML::display('signup_form', { error => $db->error, main_title_loop => $mtl });
return;
}
}
else {
$user->{Status} = "Registered";
$user->{Validation} = 0;
my $ret = $db->add($user);
if (!$ret) {
print $IN->header();
print Links::SiteHTML::display('signup_form', { error => $db->error, main_title_loop => $mtl });
return;
}
}
# Print the welcome screen.
if ($CFG->{user_validation}) {
print $IN->header();
print Links::SiteHTML::display('signup_success', { %$user, main_title_loop => $mtl });
Links::send_email('validate.eml', $user) or die "Unable to send message: $GT::Mail::error";
}
else {
my $results = Links::Authenticate::auth('create_session', { Username => $user->{Username} });
$USER = Links::Authenticate::auth('get_user', { Username => $user->{Username}, Password => $user->{Password}, auto_create => 1 });
print $IN->header();
print Links::SiteHTML::display('signup_success', { %$user, main_title_loop => $mtl });
}
}
sub validate_user {
# --------------------------------------------------------
# Validates a user.
#
my $code = $IN->param('code');
$code =~ s/^\s*|\s*$//g;
my $mtl = Links::Build::build('title', Links::language('LINKS_VALIDATE'), "$CFG->{db_cgi_url}/user.cgi?validate=1");
if (!$code) {
print $IN->header;
print Links::SiteHTML::display('validate_form', { error => Links::language('USER_INVALIDVAL'), main_title_loop => $mtl });
return;
}
my $db = $DB->table('Users');
my $sth = $db->select({ Validation => $code });
my $user = $sth->fetchrow_hashref;
if (! $user) {
print $IN->header;
print Links::SiteHTML::display('validate_form', { error => Links::language('USER_INVALIDVAL'), main_title_loop => $mtl });
return;
}
$db->update({ Status => 'Registered' }, { Username => $user->{Username} });
login_user($user->{Username}, $user->{Password}, 'validate_success');
}
sub send_pass {
# -------------------------------------------------------------------
# Sends the user a password reminder email.
#
my $email = $IN->param('Email');
my $user_db = $DB->table('Users');
my $sth = $user_db->select( { Email => $email } );
print $IN->header();
my $user = $sth->fetchrow_hashref;
if ($user and $email =~ /.+\@.+\..+/) {
Links::send_email('password.eml', { %$user, %ENV }) or die "Unable to send message: $GT::Mail::error";
print Links::SiteHTML::display('login', { error => Links::language('USER_PASSSENT'), Username => '', Password => '', main_title_loop => Links::Build::build('title', Links::language('LINKS_LOGIN'), "$CFG->{db_cgi_url}/user.cgi") });
}
else {
print Links::SiteHTML::display('login_email', { error => Links::language('USER_NOEMAIL'), main_title_loop => Links::Build::build('title', Links::language('LINKS_EMAILPASS'), "$CFG->{db_cgi_url}/user.cgi?email_pass=1") });
}
}
sub send_validate {
# -------------------------------------------------------------------
# Sends the validation email if the user needs another one.
#
my $email = $IN->param('Email');
my $user_db = $DB->table('Users');
my $sth = $user_db->select( { Email => $email } );
print $IN->header();
if ($sth->rows) {
# Prepare the message.
my $user = $sth->fetchrow_hashref;
# Make sure there is a validation code.
if (! $user->{Validation}) {
$user->{Validation} = (time) . ($$) . (int rand(1000));
$user_db->modify($user);
}
Links::send_email('validate.eml', $user) or die "Unable to send message: $GT::Mail::error";
print Links::SiteHTML::display('login', { error => Links::language('USER_VALSENT'), Username => '', Password => '', main_title_loop => Links::Build::build('title', Links::language('LINKS_LOGIN'), "$CFG->{db_cgi_url}/user.cgi") });
}
else {
print Links::SiteHTML::display('login_email', { error => Links::language('USER_NOEMAIL'), main_title_loop => Links::Build::build('title', Links::language('LINKS_EMAILPASS'), "$CFG->{db_cgi_url}/user.cgi?email_pass=1") });
}
}
1;

571
site/slowtwitch.com/cgi-bin/articles/admin/Links/User/Modify.pm Normal file
View File

@ -0,0 +1,571 @@
# ==================================================================
# 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: Modify.pm,v 1.82 2013/02/01 04:43:56 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::User::Modify;
# ==================================================================
use strict;
use Links qw/:objects :payment/;
use Links::Build;
use Links::SiteHTML;
sub handle {
# ---------------------------------------------------
# Determine what to do.
#
my $link_id = $IN->param('LinkID');
if ($CFG->{user_required} and !$USER) {
print $IN->redirect(Links::redirect_login_url('modify'));
return;
}
# Perform the link modification
if ($IN->param('modify')) {
_modify();
}
elsif ($USER) {
# Display the link modify form (for a specific link)
if ($IN->param('LinkID')) {
_modify_passed_in();
}
else {
_list_owned_links();
}
}
# Display the link modify form (used when user_required is off)
else {
_modify_form();
}
}
# ==============================================================
sub _modify {
# --------------------------------------------------------
# Modifies a link.
#
# If payment is enabled and we are processing a payment
if ($CFG->{payment}->{enabled} and $IN->param('process_payment')) {
my $payment_term = $IN->param('payment_term') || '';
my $do = $IN->param('do') || '';
if ($payment_term eq 'free') {
print $IN->header();
my $link = $DB->table('Links')->get(scalar $IN->param('link_id'));
my $mtl = Links::Build::build('title', Links::language('LINKS_MODIFY_SUCCESS'), "$CFG->{db_cgi_url}/modify.cgi");
if (not $link or ($CFG->{user_required} and $link->{LinkOwner} ne $USER->{Username})) {
print Links::SiteHTML::display('error', { error => !$link ? $GT::SQL::ERRORS : Links::language('PAYMENTERR_NOTOWNER'), main_title_loop => $mtl });
return;
}
$link = Links::SiteHTML::tags('link', $link);
# Add some special tags for formatting.
$link->{Category} = $DB->table('Category', 'CatLinks')->select('Category.Full_Name', { 'CatLinks.LinkID' => $link->{ID} })->fetchrow;
# Set ExpiryDate to free
$link->{'CatLinks.CategoryID'} = $IN->param('cat_id');
$link->{ExpiryDate} = FREE;
$link->{ExpiryNotify}= 0;
# Update the link
$DB->table('Links')->update({ ExpiryDate => FREE, ExpiryNotify => 0 }, { ID => $link->{ID} });
# Update the Timestmp for link's categories so they get rebuilt with build changed
my @cats = $DB->table('Links', 'CatLinks')->select('CategoryID', { LinkID => $link->{ID} })->fetchall_list;
$DB->table('Category')->update({ Timestmp => \'NOW()' }, { ID => \@cats });
print Links::SiteHTML::display('modify_success', { %$link, main_title_loop => $mtl });
}
elsif ($do eq 'payment_linked') {
print $IN->header;
my $link = $DB->table('Links', 'CatLinks')->select({ ID => scalar $IN->param('ID') })->fetchrow_hashref;
if (!$link) {
print Links::SiteHTML::display('error', { error => Links::language('MODIFY_NOLINKS') });
return;
}
elsif ($CFG->{user_required} and $link->{LinkOwner} ne $USER->{Username}) {
print Links::SiteHTML::display('error', { error => Links::language('PAYMENTERR_NOTOWNER') });
return;
}
$link = Links::SiteHTML::tags('link', $link);
require Links::Payment;
my @cid = $DB->table('CatLinks')->select('CategoryID', { LinkID => $link->{ID} })->fetchall_list;
my $opt = Links::Payment::load_cat_price(\@cid);
if ($opt->{payment_mode} == NOT_ACCEPTED) {
print Links::SiteHTML::display('error', { error => Links::language('PAYMENTERR_NOTACCEPTED') });
return;
}
$link->{link_id} = $link->{ID}; # we need a different tag since both Category and Link have ID
$opt->{CategoryID} = delete $opt->{ID}; # remove category id
$opt->{CategoryDescription} = delete $opt->{Description};
$link->{main_title_loop} = Links::Build::build('title', Links::language('LINKS_PAYMENT'), "$CFG->{db_cgi_url}/modify.cgi?do=payment_linked;process_payment=1;modify=1;ID=$link->{link_id}");
print Links::SiteHTML::display('payment', { %$link, %$opt });
}
elsif ($do =~ /^payment_(method|form|direct)$/) {
require Links::Payment;
my $vars = Links::Payment->$1();
my $page = $IN->param('page') || $IN->param('do');
my $opt = Links::Payment::load_cat_price($IN->param('cat_id'));
if ($opt->{payment_mode} == NOT_ACCEPTED) {
print Links::SiteHTML::display('error', { error => Links::language('PAYMENTERR_NOTACCEPTED') });
return;
}
my $link = $DB->table('Links')->get($IN->param('link_id'));
print $IN->header();
if (not $link or $link->{LinkOwner} ne $USER->{Username}) {
print Links::SiteHTML::display('error', { error => !$link ? $GT::SQL::ERRORS : Links::language('PAYMENTERR_NOTOWNER') });
return;
}
$link = Links::SiteHTML::tags('link', $link);
$link->{main_title_loop} = Links::Build::build('title', Links::language('LINKS_PAYMENT'), "$CFG->{db_cgi_url}/modify.cgi?do=payment_linked;process_payment=1;modify=1;ID=$link->{ID}");
print Links::SiteHTML::display($page, { %$vars, %$opt, %$link });
}
else {
print $IN->header;
print Links::SiteHTML::display('error', { error => "Invalid action" });
}
}
# Otherwise, modify the link
else {
my $results = $PLG->dispatch('user_modify_link', \&modify_link, {});
if (defined $results->{error}) {
print $IN->header();
print Links::SiteHTML::display('modify', $results);
}
else {
$results->{main_title_loop} = Links::Build::build('title', Links::language('LINKS_MODIFY_SUCCESS'), "$CFG->{db_cgi_url}/modify.cgi");
if ($CFG->{payment}->{enabled}) {
require Links::Payment;
my @cid = $IN->param('CatLinks.CategoryID');
my $opt = Links::Payment::load_cat_price(\@cid);
print $IN->header();
if (exists $opt->{error}) {
print Links::SiteHTML::display('error', $opt);
}
elsif ($opt->{payment_mode} == NOT_ACCEPTED or ($results->{ExpiryDate} >= time)) {
print Links::SiteHTML::display('modify_success', $results);
}
else {# display payment form if the link is expired or payment mode for this category is required or optional
$results->{link_id} = $results->{ID}; # we need a different tag since both Category and Link have ID
$opt->{CategoryID} = delete $opt->{ID}; # remove category id
$opt->{CategoryDescription} = delete $opt->{Description};
$results->{main_title_loop} = Links::Build::build('title', Links::language('LINKS_PAYMENT'), "$CFG->{db_cgi_url}/modify.cgi?do=payment_linked;process_payment=1;modify=1;ID=$results->{link_id}");
print Links::SiteHTML::display('payment', {%$results,%$opt});
}
}
else {
print $IN->header();
print Links::SiteHTML::display('modify_success', $results);
}
}
}
}
sub _modify_passed_in {
# --------------------------------------------------------
# Display link that was passed in.
#
my $lid = $IN->param('LinkID');
my $link_db = $DB->table('Links');
my $mtl = Links::Build::build('title', Links::language('LINKS_MODIFY'), "$CFG->{db_cgi_url}/modify.cgi?LinkID=$lid");
my $sth = $link_db->select({ ID => $lid, LinkOwner => $USER->{Username} }, VIEWABLE);
if ($sth->rows) {
my $link = $sth->fetchrow_hashref;
my @ids = $DB->table('CatLinks')->select('CategoryID', { LinkID => $link->{ID} })->fetchall_list;
$IN->param('CatLinks.CategoryID', \@ids);
$link->{Contact_Name} ||= $USER->{Name} || $USER->{Username};
$link->{Contact_Email} ||= $USER->{Email};
my $category = {};
if ($CFG->{db_gen_category_list} < 2) {
require Links::Tools;
$category = Links::Tools::category_list();
$category->{Category} = sub { Links::Tools::category_list_html() };
}
print $IN->header();
print Links::SiteHTML::display('modify', {
main_title_loop => $mtl,
%$link,
%$category
});
}
elsif (!$CFG->{user_required}) {
_modify_form();
}
else {
print $IN->header();
print Links::SiteHTML::display('error', { error => Links::language('MODIFY_NOTOWNER'), LinkID => $lid, main_title_loop => $mtl });
}
}
sub _list_owned_links {
# --------------------------------------------------------
# Display a list of links the user owns.
#
my $link_db = $DB->table('Links');
my ($limit, $offset, $nh) = Links::limit_offset();
my $mtl = Links::Build::build('title', Links::language('LINKS_MODIFY'), "$CFG->{db_cgi_url}/modify.cgi");
$link_db->select_options("ORDER BY Title ASC", "LIMIT $limit OFFSET $offset");
my $sth = $link_db->select({
LinkOwner => $USER->{Username},
# If payment is enabled, we want to show non-validated links to allow
# payment to occur, otherwise only show validated ones
($CFG->{payment}->{enabled} ? () : (isValidated => 'Yes'))
});
my $total = $link_db->hits;
if (! $sth->rows) {
print $IN->header();
print Links::SiteHTML::display('error', { error => Links::language('MODIFY_NOLINKS'), main_title_loop => $mtl });
return;
}
my ($toolbar, %paging);
my @links;
while (my $hash = $sth->fetchrow_hashref) {
push @links, Links::SiteHTML::tags('link', $hash);
}
if ($total > $limit) {
my $url = $CFG->{db_cgi_url} . "/" . $IN->url;
$toolbar = $DB->html(['Links'], $IN)->toolbar($nh, $limit, $total, $url);
%paging = (
url => $url,
num_hits => $total,
max_hits => $limit,
current_page => $nh
);
}
print $IN->header();
print Links::SiteHTML::display('modify_select', {
link_results_loop => \@links,
main_title_loop => $mtl,
total => $total,
next => $toolbar,
paging => \%paging
});
}
sub _modify_form {
# --------------------------------------------------------
# Just display the regular form.
#
my @id = $IN->param('ID'); # Category ID.
my $link = {};
print $IN->header();
if ($IN->param('LinkID')) {
my $lid = $IN->param('LinkID');
$link = $DB->table('Links')->select({ ID => $lid }, VIEWABLE)->fetchrow_hashref;
if (!$link) {
print Links::SiteHTML::display('error', { error => Links::language('MODIFY_INVALIDLINKID', $lid) });
return;
}
if (!@id) {
@id = $DB->table('CatLinks')->select('CategoryID', { LinkID => $lid })->fetchall_list;
# Set ID to the categories that the link is in so Links::Tools::category_list
# pre-selects them
$IN->param(ID => \@id);
}
}
if (!@id and !$CFG->{db_gen_category_list}) {
print Links::SiteHTML::display('error', { error => Links::language('MODIFY_SELCAT') });
}
else {
my $category = {};
if ($CFG->{db_gen_category_list} < 2) {
require Links::Tools;
$category = Links::Tools::category_list();
$category->{Category} = sub { Links::Tools::category_list_html() };
}
print Links::SiteHTML::display('modify', {
main_title_loop => Links::Build::build('title', Links::language('LINKS_MODIFY'), "$CFG->{db_cgi_url}/modify.cgi" . (@id ? "?ID=" . join(';ID=', @id) : '')),
%$category,
%$link
});
}
}
sub modify_link {
# --------------------------------------------------------
# Change the requested link.
#
my $args = $IN->get_hash();
my $db = $DB->table('Links');
my %cols = $db->cols;
# Make it possible to use any column to find the link we're modifying.
# Normally, we use the LinkID to find the link, but in some conditions the URL
# is used. Using this isn't recommended as you're not guaranteed to get the
# same or unique results.
my ($column, $value);
foreach my $col (keys %cols) {
if (exists $args->{'Current_' . $col} and $args->{'Current_' . $col}) {
$column = $col;
$value = $args->{'Current_' . $col};
last;
}
}
my $lid = $args->{LinkID};
my %ret;
if ($CFG->{db_gen_category_list} < 2) {
require Links::Tools;
%ret = %{Links::Tools::category_list()};
$ret{Category} = sub { Links::Tools::category_list_html() };
}
$ret{main_title_loop} = Links::Build::build('title', Links::language('LINKS_MODIFY'), "$CFG->{db_cgi_url}/modify.cgi" . ($lid ? "?LinkID=$lid" : ''));
$ret{LinkID} = $lid;
unless ($value or ($lid and $USER)) {
return { error => Links::language('MODIFY_NOURL'), %ret };
}
# Find the requested link
my ($link, $sth);
if ($USER and $lid) {
#if ($CFG->{user_required}) {
# Mod added back on April 10 by Virginia
if ($CFG->{user_required} and $USER->{Status} ne 'Administrator') { # mod by Virginia Lo on Oct 29, 2007
$sth = $db->select({ ID => $lid, LinkOwner => $USER->{Username} });
}
else {
$sth = $db->select({ ID => $lid });
}
$sth->rows or return { error => Links::language('MODIFY_INVALIDLINKID', $lid), %ret };
}
else {
$sth = $db->select({ $column => $value });
$sth->rows or return { error => Links::language('MODIFY_BADURL', $value), %ret };
}
$link = $sth->fetchrow_hashref;
# Make sure to only allow modifications to validated links. We currently allow
# the user to modify expired links.
unless ($link->{isValidated} eq 'Yes') {
return { error => Links::language('MODIFY_NOLINKS'), %ret };
}
my $new = {%$args};
# Forced system fields (these aren't in the add_system_fields option)
my @system = qw/ID LinkOwner Add_Date Mod_Date Timestmp Date_Checked ExpiryDate ExpiryCounted ExpiryNotify LinkExpired/;
my %system = map { $_ => 1 } @system;
for my $key (keys %cols) {
# Users can't modify system fields, so remove them so the columns don't get
# modified
if (exists $system{$key} or exists $CFG->{add_system_fields}->{$key}) {
delete $new->{$key};
next;
}
# Use the original link value if it hasn't been passed in from cgi. This is
# done to make sure all Links columns pass the column checks (not null, regex,
# etc checks). It has to be done for all columns, since column definitions may
# have changed since the record was originally inserted.
$new->{$key} = $link->{$key} unless defined $args->{$key};
}
# 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($link);
$new->{ExpiryDate} = $expiry if $expiry;
}
# modify() needs the primary key to perform the update
$new->{ID} = $link->{ID};
Links::init_date();
$new->{Mod_Date} = GT::Date::date_get();
# Backwards compatibility
$new->{Contact_Name} = $args->{Contact_Name} || $args->{'Contact Name'} || ($USER ? $USER->{Name} : '');
$new->{Contact_Email} = $args->{Contact_Email} || $args->{'Contact Email'} || ($USER ? $USER->{Email} : '');
# Setup the language for GT::SQL
local $GT::SQL::ERRORS->{ILLEGALVAL} = Links::language('ADD_ILLEGALVAL');
local $GT::SQL::ERRORS->{UNIQUE} = Links::language('ADD_UNIQUE');
local $GT::SQL::ERRORS->{NOTNULL} = Links::language('ADD_NOTNULL');
local $Links::Table::Links::ERRORS->{NOCATEGORY} = Links::language('MODIFY_NOCATEGORY');
$Links::Table::Links::ERRORS if 0; # silence -w
# On error, file column values need to be restored (since they need to get
# re-uploaded). This is done so that the templates show the correct fields on
# an error.
my %fcols = $db->_file_cols();
for (keys %fcols) {
$ret{$_} = $link->{$_};
}
# Because we store the change request in the Changes table and do not perform
# the modify directly, all the column checks that modify() would normally do
# need to be done now.
my $fset;
unless ($USER and $CFG->{user_direct_mod}) {
if (keys %fcols) {
require GT::SQL::File;
my $file = GT::SQL::File->new({ parent_table => $DB->table('Links'), connect => $DB->{connect} });
$fset = $file->pre_file_actions(\%fcols, $new, $args, $new->{ID}) or return { error => $GT::SQL::error, %ret };
}
# The following block of code modifies $new (so that _check_update() works
# properly), but we don't want that later on, so make a shallow copy of it.
my $new_copy = { %$new };
# This block of code is pulled from GT::SQL::Table::modify (minus the comments)
my $cols = $db->{schema}->{cols};
for my $col (keys %$cols) {
next unless exists $new_copy->{$col};
if ($cols->{$col}->{type} eq 'TIMESTAMP') {
delete $new_copy->{$col};
}
elsif ($cols->{$col}->{type} =~ /^(?:.*INT|INTEGER|FLOAT|REAL|DOUBLE|DECIMAL|DATE|TIME|DATETIME)$/ and defined $new_copy->{$col} and $new_copy->{$col} eq '') {
$new_copy->{$col} = undef;
}
elsif ($cols->{$col}->{not_null} and not (defined $new_copy->{$col} and length $new_copy->{$col})) {
$new_copy->{$col} = undef;
}
}
$db->_check_update($new_copy, { ID => $new_copy->{ID} }) or return { error => $GT::SQL::error, %ret };
}
# Make sure the category id's are valid
$IN->param('CatLinks.CategoryID')
or return { error => Links::language('MODIFY_NOCATEGORY'), %ret };
# Set the Category ID's
my @c_ids = $IN->param('CatLinks.CategoryID');
$new->{'CatLinks.CategoryID'} = $db->clean_category_ids(\@c_ids)
or return { error => $GT::SQL::error, %ret };
# Check if the link is valid
if ($CFG->{user_link_validation}) {
require Links::Tools;
my $status = Links::Tools::link_status($new->{URL});
if ($status and $Links::Tools::STATUS_BAD{$status}) {
return { error => Links::language('MODIFY_BADSTATUS', $Links::Tools::STATUS_BAD{$status}), %ret };
}
}
my $orig_cats = $db->get_categories($new->{ID});
my $new_cats;
# Add the link either directly in, or into the change request table.
if ($USER and $CFG->{user_direct_mod}) {
if ($USER->{Status} ne 'Administrator' and $link->{LinkOwner} ne $USER->{Username}) {
return { error => Links::language('MODIFY_NOTOWNER'), %ret };
}
my $res = $db->modify($new) or return { error => $GT::SQL::error, %ret };
$new_cats = $db->get_categories($new->{ID});
}
else {
require GT::Dumper;
my $chg_db = $DB->table('Changes');
# Remove any columns which haven't changed
for my $key (keys %cols) {
next if not exists $new->{$key} or $key eq 'ID';
delete $new->{$key} if $new->{$key} eq (defined $link->{$key} ? $link->{$key} : '');
}
# Handle updating the expiry date later on (when the admin does the change
# validation). It can't be done here because payments can be made to the link
# before the change validation occurs, losing the user's updated expiry date.
delete $new->{ExpiryDate};
# pre_file_actions() pulls the file columns out of the $new hash; put them back
# in and save the uploaded file(s) in a temporary location for processing upon
# change validation.
foreach my $col (keys %fcols) {
if (exists $fset->{$col}) {
my $fh = $fset->{$col};
my $fname = GT::CGI->escape(get_filename($fh));
my $fpath = "$CFG->{admin_root_path}/tmp/$new->{ID}-$fname";
open F, ">$fpath";
binmode F; binmode $fh;
my $buf;
while (read $fh, $buf, 4096) { print F $buf; };
close F;
$new->{$col} = $fpath;
$new->{"${col}_filename"} = $fset->{"${col}_filename"} || get_filename($fh);
}
elsif (exists $fset->{"${col}_del"}) {
$new->{"${col}_del"} = $fset->{"${col}_del"};
}
}
my $count = $chg_db->count({ LinkID => $new->{ID} });
if ($count) {
my $href = $chg_db->select('ChgRequest', { LinkID => $new->{ID} })->fetchrow;
$href = eval $href;
foreach (keys %fcols) {
my $fpath = $href->{$_} or next;
$fpath ne $new->{$_} or next;
$fpath !~ /\.\./ or next;
$fpath =~ /^[\w\\\/\-\.%]+$/ or next;
-e $fpath or next;
$fpath =~ m,^\Q$CFG->{admin_root_path}\E/tmp/, or next;
unlink $fpath;
}
$chg_db->update({ LinkID => $new->{ID}, Username => $link->{LinkOwner}, ChgRequest => GT::Dumper->dump({ data => $new, var => '' }) }, { LinkID => $new->{ID} })
or return { error => $GT::SQL::error, %ret };
}
else {
$chg_db->insert({ LinkID => $new->{ID}, Username => $link->{LinkOwner}, ChgRequest => GT::Dumper->dump({ data => $new, var => '' }) })
or return { error => $GT::SQL::error, %ret };
}
my $cdb = $DB->table('Category');
foreach my $id (@c_ids) {
my $cat = $cdb->get($id, 'HASH', ['Full_Name']);
$new_cats->{$id} = $cat->{Full_Name};
}
}
# Now email the site admin.
if ($CFG->{admin_email_mod}) {
my %tags;
for my $key (keys %$link) {
$tags{"Original_" . $key} = $link->{$key};
$tags{"New_" . $key} = exists $new->{$key} ? $new->{$key} : $link->{$key};
}
# Pull in the extra fields that might be in $new (eg. extra file data)
for my $key (keys %$new) {
next if exists $tags{"New_" . $key};
$tags{"New_" . $key} = $new->{$key};
}
$tags{Original_Category} = join "\n", sort values %$orig_cats;
$tags{Original_Category_loop} = [sort values %$orig_cats];
$tags{New_Category} = join "\n", sort values %$new_cats;
$tags{New_Category_loop} = [sort values %$new_cats];
$GT::Mail::error ||= '';
Links::send_email('link_modified.eml', \%tags, { admin_email => 1 }) or die "Unable to send message: $GT::Mail::error";
}
$new->{Category} = join("\n", sort values %$new_cats);
$new->{Category_loop} = [sort values %$new_cats];
# All done!
return { %$args, %$link, %$new };
}
sub get_filename {
# -------------------------------------------------------------------
my $fpath = shift;
my @path = split /[\\\/]/, $fpath;
return pop @path;
}
1;

250
site/slowtwitch.com/cgi-bin/articles/admin/Links/User/Page.pm Normal file
View File

@ -0,0 +1,250 @@
# ==================================================================
# 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: Page.pm,v 1.33 2007/12/19 06:59:12 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::User::Page;
# ==================================================================
use strict;
use Links qw/:objects/;
use Links::Build;
use Links::SiteHTML;
sub handle {
# --------------------------------------------------------------
# Wrap in a subroutine to prevent possible mod_perl probs.
#
$ENV{PATH_INFO} and ($ENV{PATH_INFO} =~ s/.*page\.cgi//);
my $page = $IN->param('g') || $ENV{PATH_INFO} || '';
# We can display a custom template by passing in p=template (the p is for
# page).
my $custom = $IN->param('p') || '';
return generate_custom_page($custom) if $custom;
# Clean up page a little.
$page =~ s|^/+||;
$page =~ s|/+$||;
# Reset the grand total.
$Links::Build::GRAND_TOTAL = 0;
# Figure out what to look for.
my ($new_match) = $CFG->{build_new_url} =~ m{^\Q$CFG->{build_root_url}\E/(.+)};
my ($cool_match) = $CFG->{build_cool_url} =~ m{^\Q$CFG->{build_root_url}\E/(.+)};
my ($rate_match) = $CFG->{build_ratings_url} =~ m{^\Q$CFG->{build_root_url}\E/(.+)};
# Strip out the index.html/more*.html if it is there.
$page =~ s{/*(?:\Q$CFG->{build_home}\E|\Q$CFG->{build_index}\E|\Q$CFG->{build_more}\E\d+\Q$CFG->{build_extension}\E)$}{};
if ($new_match and $page =~ m{^\Q$new_match\E(?:/|$)}) {
$PLG->dispatch('generate_new', \&generate_new_page);
}
elsif ($cool_match and $page =~ m{^\Q$cool_match\E(?:/|$)}) {
$PLG->dispatch('generate_cool', \&generate_cool_page);
}
elsif ($rate_match and $page =~ m{^\Q$rate_match\E/?$}) {
$PLG->dispatch('generate_rate', \&generate_rate_page);
}
# By default the detailed page format in dynamic mode will be
# "<%config.build_detailed_url%>/<%ID%>.<%build_extension%>", but other certain
# formats can be used without breaking other URLs.
elsif ($page =~ /\d+\Q$CFG->{build_extension}\E$/) {
$PLG->dispatch('generate_detailed', \&generate_detailed_page);
}
elsif ($page !~ /\S/) {
$PLG->dispatch('generate_home', \&generate_home_page);
}
elsif ($page =~ /(\w+\.cgi)/) {
print $IN->redirect("$CFG->{db_cgi_url}/$1");
}
else {
$PLG->dispatch('generate_category', \&generate_category_page);
}
}
sub generate_custom_page {
# --------------------------------------------------------
# Displays a custom template.
#
my $page = shift;
if ($CFG->{dynamic_404_status}) {
my $template_set = Links::template_set();
if (! Links::template_exists($template_set, "$page.html")) {
print "Status: 404" . $GT::CGI::EOL;
}
}
print $IN->header();
print Links::SiteHTML::display($page, {});
}
sub generate_home_page {
# --------------------------------------------------------
# Display the home page.
#
print $IN->header();
print Links::Build::build(home => {});
}
sub generate_category_page {
# --------------------------------------------------------
# This routine will display a category, first thing we need
# to do is figure out what category we've been asked for.
#
my $page_num = 1;
my $page = $IN->param('g') || $ENV{PATH_INFO} || '';
$page_num = $1 if $page =~ s{/\Q$CFG->{build_more}\E(\d+)\Q$CFG->{build_extension}\E$}{};
$page =~ s/\Q$CFG->{build_index}\E$//;
$page =~ s|^/+||;
$page =~ s|/+$||;
my $like = $page;
$page =~ y/_/ /;
# Now we get the ID number of the category based on the URL.
my $cat_db = $DB->table('Category');
my $id;
if ($CFG->{build_category_dynamic} eq 'ID' or $page =~ /^\d+$/) {
($id) = $page =~ /(\d+)$/;
# Make sure the ID is valid
$id = $cat_db->select(ID => { ID => $id })->fetchrow;
}
else {
$id = $cat_db->select(ID => { ($CFG->{build_category_dynamic} || 'Full_Name') => $page })->fetchrow;
}
if (!$id) {
# Oops, we may have had a escaped character '_' that wasn't a space. We need
# to look it up manually.
$like =~ y/'"//d;
$id = $cat_db->select(ID => GT::SQL::Condition->new(($CFG->{build_category_dynamic} || 'Full_Name') => LIKE => $like))->fetchrow;
}
# Check for valid sort order.
my %opts;
$opts{id} = $id;
$opts{nh} = $page_num;
$opts{sb} = $IN->param('sb');
$opts{so} = $IN->param('so');
$opts{cat_sb} = $IN->param('cat_sb');
$opts{cat_so} = $IN->param('cat_so');
unless ($opts{sb} and exists $DB->table('Links')->cols->{$opts{sb}} and (not $opts{so} or $opts{so} =~ /^(?:desc|asc)$/i)) {
delete $opts{sb};
delete $opts{so};
}
unless ($opts{cat_sb} and exists $DB->table('Category')->cols->{$opts{cat_sb}} and (not $opts{cat_so} or $opts{cat_so} =~ /^(?:desc|asc)$/i)) {
delete $opts{cat_sb};
delete $opts{cat_so};
}
if ($id) {
print $IN->header();
print Links::Build::build('category', \%opts);
}
else {
print "Status: 404" . $GT::CGI::EOL if $CFG->{dynamic_404_status};
print $IN->header();
print Links::SiteHTML::display('error', { error => Links::language('PAGE_INVALIDCAT', $page) });
}
}
sub generate_new_page {
# --------------------------------------------------------
# Creates a "What's New" page. Set build_span_pages to 1 in setup
# and it will create a seperate page for each date.
#
my ($page, $date);
$page = $IN->param('g') || $ENV{PATH_INFO} || '';
if ($page =~ /\Q$CFG->{build_index}\E$/) {
$date = '';
}
else {
($date) = $page =~ m{/([^/]+)\Q$CFG->{build_extension}\E$};
}
if ($date) {
my $nh = 1;
my $lpp = $CFG->{build_links_per_page} || 25;
if ($date =~ s/_(\d+)//) {
$nh = $1;
}
print $IN->header();
print Links::Build::build('new_subpage', { date => $date, mh => $lpp, nh => $nh });
}
elsif ($CFG->{build_new_date_span_pages}) {
print $IN->header();
print Links::Build::build('new_index', {});
}
else {
print $IN->header();
print Links::Build::build('new', {});
}
}
sub generate_cool_page {
# --------------------------------------------------------
# Creates a "What's Cool" page.
#
my $page = $IN->param('g') || $ENV{PATH_INFO} || '';
my $nh = 1;
my $mh = $CFG->{build_span_pages} ? $CFG->{build_links_per_page} : 1000;
if ($page =~ /\Q$CFG->{build_more}\E(\d+)\Q$CFG->{build_extension}\E$/) {
$nh = $1;
}
print $IN->header();
print Links::Build::build('cool', { mh => $mh, nh => $nh });
}
sub generate_rate_page {
# --------------------------------------------------------
# Creates a Top 10 ratings page.
#
print $IN->header();
print Links::Build::build('rating', {});
}
sub generate_detailed_page {
# --------------------------------------------------------
# This routine build a single page for every link.
#
my ($page, $id, $link, $detail_match);
$page = $IN->param('g') || $ENV{PATH_INFO} || '';
($id) = $page =~ /(\d+)\Q$CFG->{build_extension}\E$/;
# Fetch the category info if the link is in multiple categories and the category
# the detailed page was accessed from was passed in. This is done so the next
# and previous links are correct.
# Note that due to the URL transformation (Links::clean_output), it isn't
# possible to pass in the CategoryID unless the detailed url is self generated
# (ie. <%detailed_url%> isn't used).
if ($id) {
my $cat_id = $IN->param('CategoryID');
if ($cat_id and $DB->table('CatLinks')->count({ LinkID => $id, CategoryID => $cat_id })) {
$link = $DB->table(qw/Links CatLinks Category/)->select({ LinkID => $id, CategoryID => $cat_id })->fetchrow_hashref;
}
else {
$link = $DB->table('Links')->get($id, 'HASH');
}
}
if (!$link) {
print "Status: 404" . $GT::CGI::EOL if $CFG->{dynamic_404_status};
print $IN->header();
print Links::SiteHTML::display('error', { error => Links::language('PAGE_INVALIDDETAIL', $page) });
return;
}
print $IN->header();
print Links::Build::build('detailed', $link);
}
1;

96
site/slowtwitch.com/cgi-bin/articles/admin/Links/User/Rate.pm Normal file
View File

@ -0,0 +1,96 @@
# ==================================================================
# 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: Rate.pm,v 1.20 2007/12/19 06:59:12 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::User::Rate;
# ==================================================================
use strict;
use Links qw/:objects/;
use Links::Build;
use Links::SiteHTML;
sub handle {
# ---------------------------------------------------
# Determine what to do.
#
my $id = $IN->param('ID');
# Make sure we are allowed to rate it.
if ($CFG->{user_rate_required} and not $USER) {
print $IN->redirect(Links::redirect_login_url('rate'));
return;
}
# Now figure out what to do.
my $mtl = Links::Build::build('title', Links::language('LINKS_RATE'), "$CFG->{db_cgi_url}/rate.cgi");
if ($IN->param('rate')) {
my $results = $PLG->dispatch('rate_link', \&rate_it, {});
$results->{main_title_loop} = $mtl;
if (defined $results->{error}) {
print $IN->header();
print Links::SiteHTML::display('rate', $results);
}
else {
print $IN->header();
print Links::SiteHTML::display('rate_success', $results);
}
}
elsif (defined $id and ($id =~ /^\d+$/)) {
print $IN->header();
my $rec = $DB->table('Links')->get($id);
unless ($rec) {
print Links::SiteHTML::display('error', { error => Links::language('RATE_INVALIDID', $id), main_title_loop => $mtl });
return;
}
$rec->{detailed_url} = $CFG->{build_detail_url} . '/' . $DB->table('Links')->detailed_url($rec->{ID}) if $CFG->{build_detailed};
print Links::SiteHTML::display('rate', { %$rec, main_title_loop => $mtl });
}
else {
print $IN->redirect($IN->param('d') ? "$CFG->{db_cgi_url}/page.cgi?d=1" : $CFG->{build_root_url} . "/" . ($CFG->{build_home} || ($CFG->{build_index_include} ? $CFG->{build_index} : '')));
}
}
sub rate_it {
# --------------------------------------------------------
# Give this link a rating.
#
my $id = $IN->param('ID');
my $rating = $IN->param('rate');
# Let's get the link information.
my $links = $DB->table('Links');
my $rec = $links->get($id);
$rec or return { error => Links::language('RATE_INVALIDID', $id) };
# Make sure we have a valid rating.
unless ($rating =~ /^\d\d?$/ and $rating >= 1 and $rating <= 10) {
return { error => Links::language('RATE_INVALIDRATE', $rating), %$rec };
}
# Update the rating unless they have already voted.
my $clicktrack = $DB->table('ClickTrack');
my $rows = $clicktrack->count({ LinkID => $id, IP => $ENV{REMOTE_ADDR}, ClickType => 'Rate' });
if ($rows) {
return { error => Links::language('RATE_VOTED', $id), %$rec };
}
else {
eval {
$clicktrack->insert({ LinkID => $id, IP => $ENV{REMOTE_ADDR}, ClickType => 'Rate', Created => \'NOW()' });
$rec->{Rating} = ($rec->{Rating} * $rec->{Votes} + $rating) / ++$rec->{Votes};
$links->update({ Rating => $rec->{Rating}, Votes => $rec->{Votes} }, { ID => $rec->{ID} });
};
return $rec;
}
}
1;

605
site/slowtwitch.com/cgi-bin/articles/admin/Links/User/Review.pm Normal file
View File

@ -0,0 +1,605 @@
# ==================================================================
# 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: Review.pm,v 1.78 2007/11/16 07:12:57 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::User::Review;
# ==================================================================
use strict;
use Links qw/:objects/;
use Links::Build;
use Links::SiteHTML;
sub handle {
# ------------------------------------------------------------------
# Determine what to do.
#
my $input = $IN->get_hash;
if ($input->{add_review}) { $PLG->dispatch('review_add', \&add_review) }
elsif ($input->{edit_review}) { $PLG->dispatch('review_edit', \&edit_review) }
elsif ($input->{helpful}) { $PLG->dispatch('review_helpful', \&helpful_review) }
else { $PLG->dispatch('review_search', \&review_search_results) }
return;
}
# ==================================================================
sub review_search_results {
# ------------------------------------------------------------------
# Display a list of validated reviews for a link
#
my $id = shift;
my $mtl = Links::Build::build('title', Links::language('LINKS_REVIEW'), "$CFG->{db_cgi_url}/review.cgi");
# Get our form data and prepare some default data.
my $args = $IN->get_hash;
$id ||= $args->{ID};
$args->{username} = '\*' if $args->{username} eq '*';
# Return error if no action
unless ($args->{keyword} or $args->{ReviewID} or $id) {
if ($USER) {
$args->{username} ||= $USER->{Username};
$IN->param(username => $args->{username});
}
elsif (!$args->{username} and !$args->{helpful}) {
print $IN->header();
print Links::SiteHTML::display('error', { error => Links::language('REVIEW_INVALID_ACTION'), main_title_loop => $mtl });
return;
}
}
# Reset ReviewID to null
my $from_helpful = ($args->{helpful}) ? $args->{ReviewID} : '';
$args->{ReviewID} = '';
# Review must be validated to list
$args->{Review_Validated} = 'Yes';
$args->{nh} = (defined $args->{nh} and $args->{nh} =~ /^(\d+)$/) ? $1 : 1;
$args->{mh} = (defined $args->{mh} and $args->{mh} =~ /^(\d+)$/) ? $1 : $CFG->{reviews_per_page};
$args->{so} = (defined $args->{so} and $args->{so} =~ /^(asc|desc)$/i) ? $1 : $CFG->{review_sort_order};
($args->{sb} and ($args->{sb} =~ /^[\w\s,]+$/) or ($args->{sb} = $CFG->{review_sort_by}));
delete $args->{ma};
my $rec = { noLink => 1 };
# If we are listing reviews of a link
if ($id) {
$id and $args->{ID} = $id;
# Check if ID is valid
$rec = $DB->table('Links')->get($args->{ID});
$rec or do {
print $IN->header();
print Links::SiteHTML::display('error', { error => Links::language('REVIEW_INVALIDID', $args->{ID}), main_title_loop => $mtl });
return;
};
$rec = Links::SiteHTML::tags('link', $rec);
$args->{Review_LinkID} = $args->{ID};
$args->{ww} = 1;
}
# If we have a user to list
elsif ($args->{username}) {
$args->{Review_LinkID} = '';
$args->{Review_Owner} = $args->{username};
$args->{'Review_Owner-opt'} = '=';
}
elsif ($IN->param('ReviewID')) {
$args->{ReviewID} = $IN->param('ReviewID');
$args->{'ReviewID-opt'} = '=';
}
my $reviews = $DB->table('Reviews');
my $review_sth = $reviews->query_sth($args);
my $review_hits = $reviews->hits;
# Return if no results.
unless ($review_hits) {
print $IN->header();
print Links::SiteHTML::display('error', { error => Links::language('REVIEW_NORESULTS', $args->{ID} || $args->{username}), main_title_loop => $mtl });
return;
}
my @review_results_loop;
Links::init_date();
my $today = GT::Date::date_get(time, GT::Date::FORMAT_DATETIME);
my %review_cache;
my $last_review = 0;
while (my $review = $review_sth->fetchrow_hashref) {
$review->{Review_Count} = $reviews->count({ Review_LinkID => $review->{Review_LinkID}, Review_Validated => 'Yes' });
$review->{Review_IsNew} = (GT::Date::date_diff($today, $review->{Review_Date}) < $CFG->{review_days_old});
if ($CFG->{review_allow_modify} and $USER->{Username} eq $review->{Review_Owner}) {
if ($CFG->{review_modify_timeout}) {
my $oldfmt = GT::Date::date_get_format();
GT::Date::date_set_format(GT::Date::FORMAT_DATETIME);
my $timeout = GT::Date::date_get(time - $CFG->{review_modify_timeout} * 60);
my $date = $review->{Review_ModifyDate} =~ /^0000-00-00 00:00:00/ ? $review->{Review_Date} : $review->{Review_ModifyDate};
if (GT::Date::date_is_greater($date, $timeout)) {
$review->{Review_CanModify} = 1;
}
GT::Date::date_set_format($oldfmt);
}
else {
$review->{Review_CanModify} = 1;
}
}
if ($review->{Review_ModifyDate} ne $review->{Review_Date} and $review->{Review_ModifyDate} !~ /^0000-00-00 00:00:00/) {
$review->{Review_ModifyDate} = GT::Date::date_transform($review->{Review_ModifyDate}, GT::Date::FORMAT_DATETIME, $CFG->{date_review_format});
}
else {
delete $review->{Review_ModifyDate};
}
$review->{Review_Date} = GT::Date::date_transform($review->{Review_Date}, GT::Date::FORMAT_DATETIME, $CFG->{date_review_format});
$review->{Num} = $review->{Review_WasHelpful} + $review->{Review_WasNotHelpful};
($from_helpful eq $review->{ReviewID}) and $review->{last_helpful} = 1;
$CFG->{review_convert_br_tags} and $review->{Review_Contents} = _translate_html($review->{Review_Contents});
# Add the link info to the review
if ($args->{username} or $args->{ReviewID} or $args->{keyword}) {
my $catlink = $DB->table('CatLinks', 'Category', 'Links');
unless (exists $review_cache{$review->{Review_LinkID}}) {
$review_cache{$review->{Review_LinkID}} = $catlink->get({ LinkID => $review->{Review_LinkID} });
}
if ($last_review != $review->{Review_LinkID}) {
my $names = $review_cache{$review->{Review_LinkID}};
$review->{LinkID} = $names->{ID};
$review->{cat_linked} = sub { Links::Build::build('title_linked', { name => $names->{Full_Name}, complete => 1 }) };
$review->{cat_loop} = Links::Build::build('title', $names->{Full_Name});
foreach my $key (keys %$names) {
next if ($key eq 'ID');
exists $review->{$key} or ($review->{$key} = $names->{$key});
}
}
$last_review = $review->{Review_LinkID};
}
push @review_results_loop, $review;
}
my ($toolbar, %paging);
if ($review_hits > $args->{mh}) {
my $url = $CFG->{db_cgi_url} . "/" . $IN->url;
$url =~ s/([;&?]?)nh=(\d+)/($1 and $1 eq '?') ? '?' : ''/eg;
$url =~ s/[;&]helpful=1//eg;
$toolbar = $DB->html($reviews, $args)->toolbar($args->{nh} || 1, $args->{mh} || 25, $review_hits, $url);
%paging = (
url => $url,
num_hits => $review_hits,
max_hits => $args->{mh} || 25,
current_page => $args->{nh} || 1
);
}
else {
$toolbar = '';
}
# Some statistics for review list
my ($review_stats,$review_count);
if (!defined $args->{keyword}) {
if ($args->{username}) {
%$review_stats = map { $_ => $reviews->count({ Review_Owner => $args->{username}, Review_Rating => $_, Review_Validated => 'Yes' }) } (1 .. 5);
$review_count = $reviews->count({ Review_Owner => $args->{username}, Review_Validated => 'Yes'} );
}
else {
%$review_stats = map { $_ => $reviews->count({ Review_LinkID => $args->{ID}, Review_Rating => $_, Review_Validated => 'Yes' }) } (1 .. 5);
$review_count = $reviews->count({ Review_LinkID => $args->{ID}, Review_Validated => 'Yes'});
}
if ($review_count) {
for (1 .. 5) {
$review_stats->{'p' . $_} = $review_stats->{$_} * 150 / $review_count;
}
}
}
$review_stats ||= { noStats => 1 };
print $IN->header();
print Links::SiteHTML::display('review_search_results', {
%$review_stats,
%$rec,
show_link_info => ($args->{username} or $args->{ReviewID} or $args->{keyword}),
main_title_loop => $mtl,
Review_Count => $review_hits,
Review_Loop => \@review_results_loop,
Review_SpeedBar => $toolbar,
paging => \%paging
});
return;
}
sub add_review {
# ------------------------------------------------------------------
# Add a review (only logged in users can add reviews if required)
#
my $id = $IN->param('ID') || '';
my $mtl = Links::Build::build('title', Links::language('LINKS_REVIEW_ADD'), "$CFG->{db_cgi_url}/review.cgi");
# Check if we have a valid ID
my $db = $DB->table('Links');
my $rec = $db->get($id);
unless ($id =~ /^\d+$/ and $rec) {
print $IN->header();
print Links::SiteHTML::display('error', { error => Links::language('REVIEW_INVALIDID', $id), main_title_loop => $mtl });
return;
}
$rec = Links::SiteHTML::tags('link', $rec);
$rec->{anonymous} = !$CFG->{user_review_required};
# Only logged in users can add reviews (if required) or must redirect to the login page
if ($CFG->{user_review_required} and !$USER) {
print $IN->redirect(Links::redirect_login_url('review'));
return;
}
my ($cat_id, $cat_name) = each %{$db->get_categories($id)};
my %title = (
title_loop => Links::Build::build('title', "$cat_name/$rec->{Title}"),
title => sub { Links::Build::build('title_unlinked', "$cat_name/$rec->{Title}") },
title_linked => sub { Links::Build::build('title_linked', "$cat_name/$rec->{Title}") }
);
print $IN->header();
# If we have a review to add from a form
if ($IN->param('add_this_review')) {
my $results = $PLG->dispatch('add_this_review', \&_add_this_review, $rec);
# If we have error
if (defined $results->{error}) {
print Links::SiteHTML::display('review_add', { %$results, %$rec, %title, main_title_loop => $mtl });
}
# Return to add success page
else {
print Links::SiteHTML::display('review_add_success', { %$results, %$rec, %title, main_title_loop => $mtl });
}
}
else {
if ($USER) {
my $reviews = $DB->table('Reviews');
my $rc = $reviews->count({ Review_LinkID => $id, Review_Owner => $USER->{Username} });
# Keep pre 3.2.0 behaviour of allowing the user to edit their existing review
if ($rc == 1 and $CFG->{review_max_reviews} == 1) {
my $review = $reviews->select({ Review_LinkID => $id, Review_Owner => $USER->{Username} })->fetchrow_hashref;
my $oldfmt = GT::Date::date_get_format();
GT::Date::date_set_format(GT::Date::FORMAT_DATETIME);
my $timeout = GT::Date::date_get(time - $CFG->{review_modify_timeout} * 60);
my $date = $review->{Review_ModifyDate} =~ /^0000-00-00 00:00:00/ ? $review->{Review_Date} : $review->{Review_ModifyDate};
if (not $CFG->{review_allow_modify} or $review->{Review_Validated} eq 'No' or ($CFG->{review_modify_timeout} and GT::Date::date_is_smaller($date, $timeout))) {
print Links::SiteHTML::display('error', { error => Links::language('REVIEW_MAX_REVIEWS', $CFG->{review_max_reviews}), main_title_loop => $mtl });
}
else {
print Links::SiteHTML::display('review_edit', {
%$rec, %title, confirm => 1,
main_title_loop => Links::Build::build('title', Links::language('LINKS_REVIEW_EDIT'), "$CFG->{db_cgi_url}/review.cgi")
});
}
GT::Date::date_set_format($oldfmt);
return;
}
elsif ($CFG->{review_max_reviews} and $rc + 1 > $CFG->{review_max_reviews}) {
print Links::SiteHTML::display('error', { error => Links::language('REVIEW_MAX_REVIEWS', $CFG->{review_max_reviews}), main_title_loop => $mtl });
return;
}
}
# We are displaying an add review form
print Links::SiteHTML::display('review_add', { %$rec, %title, main_title_loop => $mtl });
}
}
sub _add_this_review {
# ------------------------------------------------------------------
# Add this review
#
# Get our form data and some default data.
my $rec = shift;
my $reviews = $DB->table('Reviews');
my $id = $IN->param('ID');
my $input = $IN->get_hash;
$input->{Review_LinkID} = $id;
$input->{Review_Validated} = ($CFG->{review_auto_validate} == 1 and $USER or $CFG->{review_auto_validate} == 2) ? 'Yes' : 'No';
$input->{Review_WasHelpful} = 0 ;
$input->{Review_WasNotHelpful} = 0 ;
$input->{Host} = $ENV{REMOTE_HOST} ? "$ENV{REMOTE_HOST} ($ENV{REMOTE_ADDR})" : $ENV{REMOTE_ADDR} ? $ENV{REMOTE_ADDR} : 'none';
$input->{Referer} = $ENV{HTTP_REFERER} ? $ENV{HTTP_REFERER} : 'none';
# Get the review owner
$input->{Review_Owner} = $USER ? $USER->{Username} : 'admin';
if (not $CFG->{user_review_required} and not $USER) {
$input->{Review_GuestName} or return { error => Links::language('REVIEW_GUEST_NAME_REQUIRED') };
$input->{Review_GuestEmail} or return { error => Links::language('REVIEW_GUEST_EMAIL_REQUIRED') };
}
# Make sure we have a valid rating.
my $cols = $reviews->cols;
if (exists $cols->{Review_Rating} and $cols->{Review_Rating}->{not_null} and ($input->{Review_Rating} !~ /^\d$/ or $input->{Review_Rating} < 1 or $input->{Review_Rating} > 5)) {
return { error => Links::language('REVIEW_RATING', $input->{Review_Rating}) };
}
# Set date review to today's date.
Links::init_date();
$input->{Review_Date} = GT::Date::date_get(time, GT::Date::FORMAT_DATETIME);
$input->{Review_ModifyDate} = $input->{Review_Date};
# Check that the number of reviews the user owns is under the limit.
if ($USER and $CFG->{review_max_reviews} and
$CFG->{review_max_reviews} < $reviews->count({ Review_LinkID => $id, Review_Owner => $USER->{Username} }) + 1) {
return { error => Links::language('REVIEW_MAX_REVIEWS', $CFG->{review_max_reviews}) };
}
# Change the language.
local $GT::SQL::ERRORS->{ILLEGALVAL} = Links::language('ADD_ILLEGALVAL');
local $GT::SQL::ERRORS->{UNIQUE} = Links::language('ADD_UNIQUE');
local $GT::SQL::ERRORS->{NOTNULL} = Links::language('ADD_NOTNULL');
# Add the review.
# The review will be added only if Review_email_2 is blank
my $added_id = $input->{Review_email_2} ? 1 : $reviews->add($input);
$input->{ReviewID} = $added_id;
unless ($added_id) {
my $error = "<ul><li>" . join("</li><li>", $reviews->error) . "</li></ul>";
return { error => $error };
}
# Format the date for sending email
$input->{Review_Date} = GT::Date::date_transform($input->{Review_Date}, GT::Date::FORMAT_DATETIME, $CFG->{date_review_format});
# Mail the email.
if ($CFG->{admin_email_review_add}) {
Links::send_email('review_added.eml', { %{$USER || {}}, %$input, %$rec }, { admin_email => 1 }) or die "Unable to send mail: $GT::Mail::error";
}
# Review added successfully, return to review_add_success page
$CFG->{review_convert_br_tags} and $input->{Review_Contents} = _translate_html($input->{Review_Contents});
return $input;
}
sub edit_review {
# ------------------------------------------------------------------
# Edit a review (only logged in users can edit their reviews)
#
my $id = $IN->param('ID') || '';
my $rid = $IN->param('ReviewID');
my $mtl = Links::Build::build('title', Links::language('LINKS_REVIEW_EDIT'), "$CFG->{db_cgi_url}/review.cgi");
if (!$CFG->{review_allow_modify}) {
print $IN->header();
print Links::SiteHTML::display('error', { error => Links::language('REVIEW_MODIFY_DENIED'), main_title_loop => $mtl });
return;
}
# Only logged in users can update their reviews or must redirect to the login page
if (!$USER) {
print $IN->redirect(Links::redirect_login_url('review'));
return;
}
# Check if we have a valid ID
my $db = $DB->table('Links');
my $rec = $db->get($id);
unless (($id =~ /^\d+$/) and $rec) {
print $IN->header();
print Links::SiteHTML::display('error', { error => Links::language('REVIEW_INVALIDID', $id), main_title_loop => $mtl });
return;
}
$rec = Links::SiteHTML::tags('link', $rec);
# If a ReviewID isn't passed in and they have more than one review, then just edit the first review
my $review = $DB->table('Reviews')->select({ Review_LinkID => $id, Review_Owner => $USER->{Username}, $rid ? (ReviewID => $rid) : () })->fetchrow_hashref;
if (!$review) {
print $IN->header();
print Links::SiteHTML::display('error', { error => Links::language('REVIEW_NOT_EXISTS', $id), main_title_loop => $mtl });
return;
}
elsif ($review->{Review_Validated} eq 'No') {
print $IN->header();
print Links::SiteHTML::display('error', { error => Links::language('REVIEW_ADD_WAIT', $id), main_title_loop => $mtl });
return;
}
# Has the review modify period passed?
if ($CFG->{review_modify_timeout}) {
my $oldfmt = GT::Date::date_get_format();
GT::Date::date_set_format(GT::Date::FORMAT_DATETIME);
my $timeout = GT::Date::date_get(time - $CFG->{review_modify_timeout} * 60);
my $date = $review->{Review_ModifyDate} =~ /^0000-00-00 00:00:00/ ? $review->{Review_Date} : $review->{Review_ModifyDate};
my $smaller = GT::Date::date_is_smaller($date, $timeout);
GT::Date::date_set_format($oldfmt);
if ($smaller) {
print $IN->header();
print Links::SiteHTML::display('error', { error => Links::language('REVIEW_MODIFY_TIMEOUT', $CFG->{review_modify_timeout}), main_title_loop => $mtl });
return;
}
}
my ($cat_id, $cat_name) = each %{$db->get_categories($id)};
my %title = (
title_loop => Links::Build::build('title', "$cat_name/$rec->{Title}"),
title => sub { Links::Build::build('title_unlinked', "$cat_name/$rec->{Title}") },
title_linked => sub { Links::Build::build('title_linked', "$cat_name/$rec->{Title}") }
);
# If we have a review to update from a form
if ($IN->param('update_this_review')) {
my $results = $PLG->dispatch('update_this_review', \&_update_this_review, $rec);
# If we have error
if (defined $results->{error}) {
print $IN->header();
print Links::SiteHTML::display('review_edit', { %$results, %$rec, %title, main_title_loop => $mtl });
}
# Return to edit success page
else {
print $IN->header();
print Links::SiteHTML::display('review_edit_success', { %$results, %$rec, %title, main_title_loop => $mtl });
}
}
# We are displaying an edit review form
elsif ($IN->param('confirmed')) {
print $IN->header();
print Links::SiteHTML::display('review_edit', { %$rec, %$review, %title, main_title_loop => $mtl });
}
# Else invalid action
else {
return review_search_results();
}
}
sub _update_this_review {
# ------------------------------------------------------------------
# Edit this review
#
# Get our link record.
my $rec = shift;
# Get our form data and some default data.
my $input = $IN->get_hash;
my $reviews = $DB->table('Reviews');
my $id = $IN->param('ID');
$input->{Review_LinkID} = $id;
$input->{Review_Validated} = ($CFG->{review_auto_validate} == 1 and $USER or $CFG->{review_auto_validate} == 2) ? 'Yes' : 'No';
$input->{Review_WasHelpful} = 0 ;
$input->{Review_WasNotHelpful} = 0 ;
$input->{Host} = $ENV{REMOTE_HOST} ? "$ENV{REMOTE_HOST} ($ENV{REMOTE_ADDR})" : $ENV{REMOTE_ADDR} ? $ENV{REMOTE_ADDR} : 'none';
$input->{Referer} = $ENV{HTTP_REFERER} ? $ENV{HTTP_REFERER} : 'none';
# Get the review owner
$input->{Review_Owner} = $USER->{Username};
# Check if this review is valid for this user
my $rows = $reviews->get({ Review_LinkID => $id, Review_Owner => $USER->{Username}, Review_Validated => 'Yes' });
return { error => Links::language('REVIEW_INVALID_UPDATE') } unless $rows;
# Make sure we have a valid rating.
my $cols = $reviews->cols;
if (exists $cols->{Review_Rating} and $cols->{Review_Rating}->{not_null} and ($input->{Review_Rating} !~ /^\d$/ or $input->{Review_Rating} < 1 or $input->{Review_Rating} > 5)) {
return { error => Links::language('REVIEW_RATING', $input->{Review_Rating}) };
}
# Has the review modify period passed?
if ($CFG->{review_modify_timeout}) {
my $oldfmt = GT::Date::date_get_format();
GT::Date::date_set_format(GT::Date::FORMAT_DATETIME);
my $timeout = GT::Date::date_get(time - $CFG->{review_modify_timeout} * 60);
my $date = $rows->{Review_ModifyDate} =~ /^0000-00-00 00:00:00/ ? $rows->{Review_Date} : $rows->{Review_ModifyDate};
my $smaller = GT::Date::date_is_smaller($date, $timeout);
GT::Date::date_set_format($oldfmt);
if ($smaller) {
return { error => Links::language('REVIEW_MODIFY_TIMEOUT', $CFG->{review_modify_timeout}) };
}
}
# Set date review to today's date.
Links::init_date();
delete $input->{Review_Date};
$input->{Review_ModifyDate} = GT::Date::date_get(time, GT::Date::FORMAT_DATETIME);
# Change the language.
local $GT::SQL::ERRORS->{ILLEGALVAL} = Links::language('ADD_ILLEGALVAL');
local $GT::SQL::ERRORS->{UNIQUE} = Links::language('ADD_UNIQUE');
local $GT::SQL::ERRORS->{NOTNULL} = Links::language('ADD_NOTNULL');
# Update the record.
$reviews->modify($input, { ReviewID => $input->{ReviewID} }) or return { error => $GT::SQL::error };
# Delete the review track from this ReviewID
$DB->table('ClickTrack')->delete({ ReviewID => $input->{ReviewID}, ClickType => 'Review' }) or return { error => $GT::SQL::error };
# Format the date for sending email
$input->{Review_Date} = GT::Date::date_transform($input->{Review_ModifyDate}, GT::Date::FORMAT_DATETIME, $CFG->{date_review_format});
# Mail the email.
if ($CFG->{admin_email_review_mod}) {
my %tags;
foreach my $key (keys %$rows) {
$tags{"Original_$key"} = $rows->{$key};
}
foreach my $key (keys %$input) {
$tags{"New_$key"} = $input->{$key};
}
Links::send_email('review_modified.eml', { %$USER, %tags, %$rec }, { admin_email => 1 }) or die "Unable to send mail: $GT::Mail::error";
}
# Review added successfully, return to review_add_success page
$CFG->{review_convert_br_tags} and $input->{Review_Contents} = _translate_html($input->{Review_Contents});
return $input;
}
sub helpful_review {
# ------------------------------------------------------------------
# Review was helpful or not
#
my $reviewID = $IN->param('ReviewID');
my $mtl = Links::Build::build('title', Links::language('LINKS_REVIEW'), "$CFG->{db_cgi_url}/review.cgi");
# Get our Reviews db object
my $db = $DB->table('Reviews');
my $rec = $db->get($reviewID);
if (!$rec) {
print $IN->header;
print Links::SiteHTML::display('error', { error => Links::language('REVIEW_INVALIDID', $rec->{Review_Subject}), main_title_loop => $mtl });
return;
}
# Update the rating unless they have already voted.
my $click_db = $DB->table('ClickTrack');
my $rows = $click_db->count({ ReviewID => $rec->{ReviewID}, IP => $ENV{REMOTE_ADDR}, ClickType => 'Review' });
if ($rows) {
print $IN->header;
print Links::SiteHTML::display('error', { error => Links::language('REVIEW_VOTED', $rec->{Review_Subject}), main_title_loop => $mtl });
return;
}
else {
eval {
$click_db->insert({ LinkID => $rec->{Review_LinkID}, ReviewID => $rec->{ReviewID}, IP => $ENV{REMOTE_ADDR}, ClickType => 'Review', Created => \"NOW()" });
# Update the Timestmp for the link so that the detailed page gets rebuilt with build changed
$DB->table('Links')->update({ Timestmp => \'NOW()' }, { ID => $rec->{Review_LinkID} });
};
}
# Change the language.
local $GT::SQL::ERRORS->{ILLEGALVAL} = Links::language('ADD_ILLEGALVAL');
local $GT::SQL::ERRORS->{UNIQUE} = Links::language('ADD_UNIQUE');
local $GT::SQL::ERRORS->{NOTNULL} = Links::language('ADD_NOTNULL');
# If this review was helpful
if ($IN->param('yes')) {
if (!$db->update({ Review_WasHelpful => $rec->{Review_WasHelpful} + 1 }, { ReviewID => $reviewID })) {
print $IN->header;
print Links::SiteHTML::display('error', { error => $db->error, main_title_loop => $mtl });
return;
}
}
else {
if (!$db->update({ Review_WasNotHelpful => $rec->{Review_WasNotHelpful} + 1 }, { ReviewID => $reviewID })) {
print $IN->header;
print Links::SiteHTML::display('error', { error => $db->error, main_title_loop => $mtl });
return;
}
}
return review_search_results();
}
sub _translate_html {
# -------------------------------------------------------------------
# Translate contents to html format
#
my $html = shift;
$html = GT::CGI::html_escape($html);
$html =~ s,\r?\n,<br />,g;
return $html;
}
1;

359
site/slowtwitch.com/cgi-bin/articles/admin/Links/User/Search.pm Normal file
View File

@ -0,0 +1,359 @@
# ==================================================================
# 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: Search.pm,v 1.48 2006/08/08 23:30:09 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::User::Search;
# ==================================================================
use strict;
use Links qw/:objects/;
use Links::SiteHTML;
use Links::Build;
my $time_hires;
sub handle {
#--------------------------------------------------------------------------------
# Determine whether we are displaying the search form, or doing a
# search.
#
my $db = $DB->table('Links');
my $results = {};
my $args = $IN->get_hash;
# Remove search fields we aren't allowed to search on.
my @bad = (@{$CFG->{search_blocked}}, qw/isValidated ExpiryDate/);
for my $col (@bad) {
$col =~ s/^\s*|\s*$//g;
if ($args->{$col}) {
delete $args->{$col};
$IN->delete($col);
}
for (qw(lt gt opt le ge ne)) {
delete $args->{"$col-$_"};
$IN->delete("$col-$_");
}
}
# If query is set we know we are searching.
return search() if defined $args->{query} and $args->{query} =~ /\S/;
# Otherwise, if we pass in a field name, we can search on that too.
foreach (keys %{$db->cols}) {
for my $opt ('', qw/-lt -gt -le -ge -ne/) {
return search() if defined $args->{"$_$opt"} and length $args->{"$_$opt"};
}
}
print $IN->header();
print Links::SiteHTML::display('search', { main_title_loop => Links::Build::build('title', Links::language('LINKS_SEARCH'), "$CFG->{db_cgi_url}/search.cgi") });
}
sub search {
# ------------------------------------------------------------------
# Do the search and print out the results.
#
my $results = $PLG->dispatch('search_results', \&query, {});
if (defined $results->{error}) {
print $IN->header();
$results->{main_title_loop} = Links::Build::build('title', Links::language('LINKS_SEARCH'), "$CFG->{db_cgi_url}/search.cgi");
print Links::SiteHTML::display('search', $results);
}
else {
print $IN->header();
$results->{main_title_loop} = Links::Build::build('title', Links::language('LINKS_SEARCH_RESULTS'), "$CFG->{db_cgi_url}/search.cgi");
print Links::SiteHTML::display('search_results', $results);
}
if ($CFG->{debug_level} > 1) {
print "<blockquote><pre>", GT::SQL->query_stack_disp , "</pre></blockquote>";
}
}
sub query {
# ------------------------------------------------------------------
# Query the database.
#
# First get our search options.
my $args = $IN->get_hash;
if ($args->{query}) {
$args->{query} =~ s/^\s+//;
$args->{query} =~ s/\s+$//;
}
$args->{bool} = (defined $args->{bool} and $args->{bool} =~ /^(and|or)$/i) ? uc $1 : $CFG->{search_bool};
$args->{nh} = (defined $args->{nh} and $args->{nh} =~ /^(\d+)$/) ? $1 : 1;
$args->{mh} = (defined $args->{mh} and $args->{mh} =~ /^\d+$/) ? $args->{mh} : $CFG->{search_maxhits};
$args->{mh} = 200 if $args->{mh} > 200; # Safety limit
$args->{substring} = defined $args->{substring} ? $args->{substring} : $CFG->{search_substring};
$args->{so} = (defined $args->{so} and $args->{so} =~ /^(asc|desc)$/i) ? $1 : '';
$args->{sb} and ($args->{sb} =~ /^[\w\s,]+$/ or ($args->{sb} = ''));
delete $args->{ma};
# Make sure we only search on validated links.
$args->{isValidated} = 'Yes';
$args->{ExpiryDate} = '>=' . time if $CFG->{payment}->{enabled};
my $query = $args->{query} || '';
my $term = $IN->escape($query);
my $links = $DB->table('Links');
my $categories = $DB->table('Category');
# We don't do a category search if we only have a filters.
my $filter = 0;
if (!defined $query or $query eq '') {
$filter = 1;
}
$args->{filter} = $filter;
# Note: if you use this or the search_set_link_callback, remember to $PLG->action(STOP) or your callback won't be used
$args->{callback} = $PLG->dispatch('search_set_cat_callback', sub { return \&_cat_search_subcat if shift }, $args->{catid});
my $orig_sb = $args->{sb};
my $orig_so = $args->{so};
$args->{sb} = $CFG->{build_sort_order_search_cat};
$args->{so} = '';
$filter and $args->{sb} =~ s/\s*,?\s*score//;
my $started;
if (length $query and $CFG->{search_logging} and $args->{nh} == 1) {
if (!defined $time_hires) {
$time_hires = eval { require Time::HiRes } || 0;
}
$started = $time_hires ? Time::HiRes::time() : time;
}
my $cat_sth;
$cat_sth = $categories->query_sth($args) unless $filter;
my $cat_count = $filter ? 0 : $categories->hits();
$args->{callback} = $PLG->dispatch('search_set_link_callback', sub { return \&_search_subcat if shift }, $args->{catid});
$args->{sb} = $orig_sb ? $orig_sb : $CFG->{build_sort_order_search} || '';
$args->{so} = (defined $orig_so and $orig_so =~ /^(asc|desc)$/i) ? $1 : 'ASC';
$filter and $args->{sb} =~ s/\s*,?\s*score//;
# Don't force sorting by whether or not a link is paid, as that would make
# searching almost useless w.r.t. unpaid links since a 1% paid match would be
# higher than a 99% unpaid match.
my $link_sth = $links->query_sth($args);
my $link_count = $links->hits;
# Log the search if it's a new query
if (length $query and $CFG->{search_logging} and $args->{nh} == 1) {
my $elapsed = ($time_hires ? Time::HiRes::time() : time) - $started;
my $results = $link_count || 0;
my $sl = $DB->table('SearchLogs');
my $q = lc $query;
substr($q, 255) = '' if length $q > 255;
if (my $row = $sl->select({ slog_query => $q })->fetchrow_hashref) {
my $slog_time = defined $row->{slog_time}
? ($row->{slog_time} * $row->{slog_count} + $elapsed) / ($row->{slog_count} + 1)
: $elapsed;
$sl->update({
slog_count => $row->{slog_count} + 1,
slog_time => sprintf('%.6f', $slog_time),
slog_last => time,
slog_hits => $results
}, {
slog_query => $q
});
}
else {
$sl->insert({
slog_query => $q,
slog_count => 1,
slog_time => sprintf('%.6f', $elapsed),
slog_last => time,
slog_hits => $results
}) or die "$GT::SQL::error";
}
}
# Return if no results.
unless ($link_count or $cat_count) {
return { error => Links::language('SEARCH_NOLINKS', $term), term => $term };
}
# Now format the category results.
my $count = 0;
my ($category_results, @category_results_loop);
if (!$filter and $cat_count) {
while (my $cat = $cat_sth->fetchrow_hashref) {
last if ($count++ > $args->{mh});
my $title = Links::Build::build('title_linked', { name => $cat->{Full_Name}, complete => 1, home => 0 });
$category_results .= "<li>$title\n";
$cat->{title_linked} = $title;
$cat->{title_loop} = Links::Build::build('title', $cat->{Full_Name});
push @category_results_loop, $cat;
}
}
# And format the link results.
my (@link_results_loop, $link_results, %link_output);
if ($link_count) {
my $results = $link_sth->fetchall_hashref;
$links->add_reviews($results);
@link_results_loop = map Links::SiteHTML::tags('link', $_) => @$results unless $CFG->{build_search_gb};
if ($CFG->{build_search_gb}) {
my @ids = map { $_->{ID} } @$results;
my $catlink = $DB->table('CatLinks','Category');
my %names = $catlink->select('LinkID', 'Full_Name', { LinkID => \@ids })->fetchall_list;
foreach my $link (@$results) {
push @{$link_output{$names{$link->{ID}}}}, Links::SiteHTML::tags('link', $link);
}
}
}
# Join the link results by category if we are grouping.
if ($CFG->{build_search_gb}) {
foreach my $cat (sort keys %link_output) {
$link_output{$cat}->[0]->{title_linked} = sub { Links::Build::build('title_linked', { name => $cat, complete => 1, home => 0 }) };
$link_output{$cat}->[0]->{title_loop} = Links::Build::build('title', $cat);
push @link_results_loop, @{$link_output{$cat}};
}
}
$link_results = sub {
my $links;
$CFG->{build_search_gb} or return join("", map { Links::SiteHTML::display('link', $_) } @link_results_loop);
foreach my $cat (sort keys %link_output) {
my $title = Links::Build::build('title_linked', { name => $cat, complete => 1, home => 0 });
$links .= "<p>$title" . join("", map { Links::SiteHTML::display('link', $_) } @{$link_output{$cat}});
}
return $links;
};
# Generate a toolbar if requested.
my ($toolbar, %paging);
if ($link_count > $args->{mh} or $cat_count > $args->{mh}) {
my $url = $CFG->{db_cgi_url} . "/" . $IN->url;
$url =~ s/([;&?]?)nh=(\d+)/($1 and $1 eq '?') ? '?' : ''/eg;
$toolbar = Links::Build::build(search_toolbar => {
url => $url,
numlinks => $link_count > $cat_count ? $link_count : $cat_count,
nh => $args->{nh},
mh => $args->{mh}
});
%paging = (
url => $url,
num_hits => $link_count > $cat_count ? $link_count : $cat_count,
max_hits => $args->{mh},
current_page => $args->{nh}
);
}
else {
$toolbar = '';
}
# Print the output.
my $results = {
link_results => $link_results,
link_results_loop => \@link_results_loop,
category_results => $category_results,
category_results_loop => \@category_results_loop,
link_hits => $link_count,
cat_hits => $cat_count,
next => $toolbar,
paging => \%paging,
term => $term,
highlight => $CFG->{search_highlighting}
};
return $results;
}
sub _search_subcat {
# -------------------------------------------------------------------
# First argument is the query/table object, second argument is the current
# result set (note: can be quite large). Must return a new result set.
#
my ($query, $results) = @_;
return $results unless (keys %$results); # No matches.
my $cat_db = $DB->table('Category');
my $catlink_db = $DB->table('CatLinks', 'Category');
# We need the full name of the category.
my @cat_ids = $IN->param('catid') or return $results;
my (@children, %seen);
foreach my $id (@cat_ids) {
next if ($id !~ /^\d+$/);
my $child = $cat_db->children($id) or next;
push @children, @$child, $id;
}
@children or return $results;
@children = grep !$seen{$_}++, @children;
# Now do the joined query.
my %filtered = map { $_ => $results->{$_} }
$catlink_db->select(LinkID => { CategoryID => \@children, LinkID => [keys %$results] })->fetchall_list;
return \%filtered;
}
sub _search_subcat_and {
# -------------------------------------------------------------------
# Search subcategories using AND.
#
my ($query, $results) = @_;
return $results unless (keys %$results); # No matches
my $cat_db = $DB->table('Category');
my $catlink_db = $DB->table('CatLinks', 'Category');
# We need the full name of the category.
my @cat_ids = $IN->param('catid') or return $results;
my %final = %$results;
foreach my $id (@cat_ids) {
next unless ($id =~ /^\d+$/);
my @children;
my $childs = $cat_db->children($id);
push @children, @$childs, $id;
my $cond = GT::SQL::Condition->new(
CategoryID => 'IN' => \@children,
LinkID => 'IN' => [ keys %final ]
);
%final = ();
my $sth = $catlink_db->select($cond, ['LinkID']);
while (my $link_id = $sth->fetchrow_array) {
$final{$link_id} = $results->{$link_id};
}
last unless keys %final;
}
return \%final;
}
sub _cat_search_subcat {
# -------------------------------------------------------------------
# First argument is the query/table object, second argument is the current
# result set (note: can be quite large). Must return a new result set.
#
my ($query, $results) = @_;
return $results unless (keys %$results); # No matches.
my $cat_db = $DB->table('Category');
my @cat_ids = $IN->param('catid') or return $results;
my (@children, %seen);
foreach my $id (@cat_ids) {
next if ($id !~ /^\d+$/);
my $child = $cat_db->children($id) or next;
push @children, @$child, $id;
}
@children or return $results;
@children = grep { ! $seen{$_}++ } @children;
my %subcats = map { $_ => 1 } @children;
my $filtered = {};
while (my ($k, $s) = each %$results) {
$filtered->{$k} = $s if (exists $subcats{$k});
}
return $filtered;
}
1;

119
site/slowtwitch.com/cgi-bin/articles/admin/Links/User/Treecats.pm Normal file
View File

@ -0,0 +1,119 @@
# ==================================================================
# 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: Treecats.pm,v 1.3 2006/09/12 06:07:12 brewt Exp $
#
# Copyright (c) 2006 Gossamer Threads Inc. All Rights Reserved.
# Redistribution in part or in whole strictly prohibited. Please
# see LICENSE file for full details.
# ==================================================================
package Links::User::Treecats;
# ==================================================================
use strict;
use Links qw/:objects/;
sub handle {
# Fetch these categories (and select them)
my @cid = $IN->param('cid');
# Fetch these links (and select them)
my @lid = $IN->param('lid');
# Fetch these categories
my @id = $IN->param('id');
# Fetch links as well as Categories
my $fetchlinks = $IN->param('links');
my $category = $DB->table('Category');
my $catlinks = $DB->table('CatLinks', 'Links');
# Fetching selected categories
if (@cid) {
@lid = ();
@id = @cid;
$fetchlinks = 0;
}
# Fetching selected links
elsif (@lid) {
# Get all the categories that the links are in
@id = $catlinks->select('CategoryID', { LinkID => \@lid }, VIEWABLE)->fetchall_list;
$fetchlinks = 1;
}
# Fetching categories/links
else {
@cid = ();
@lid = ();
@id = (0) unless @id;
}
my %vars;
# Only allow the use of treecats.cgi if db_gen_category_list == 2 or if
# treecats_enabled (hidden config option) is true
if ($CFG->{db_gen_category_list} != 2 and not $CFG->{treecats_enabled}) {
$vars{error} = 'Permission denied - treecats is currently disabled.';
}
else {
my @fetchlinks;
my $cond;
if (@cid or @lid) {
my $parents = $category->parents(\@id);
my @ids;
my @fids = (0);
for (keys %$parents) {
# Fetch all the parents and their children
push @ids, @{$parents->{$_}};
push @fids, @{$parents->{$_}};
# Fetch the category itself
push @ids, $_;
# When pre-selecting links, @id contains the category the link(s) are in. To
# completely draw the tree, the children of those categories need to be
# retreived as well.
if (@lid) {
push @fids, $_;
push @fetchlinks, $_;
}
push @fetchlinks, @{$parents->{$_}};
}
$cond = GT::SQL::Condition->new(ID => IN => \@ids, FatherID => IN => \@fids);
$cond->bool('OR');
}
else {
push @fetchlinks, @id;
$cond = GT::SQL::Condition->new(FatherID => IN => \@id);
}
$category->select_options("ORDER BY Full_Name");
$vars{categories} = $category->select($cond)->fetchall_hashref;
# Find the children counts of all the categories and check if they should be selected or not
my @cats;
for (@{$vars{categories}}) {
push @cats, $_->{ID};
}
$category->select_options("GROUP BY FatherID");
my %children = $category->select('FatherID', 'COUNT(*)', { FatherID => \@cats })->fetchall_list;
my %selected = map { $_ => 1 } @cid;
for (@{$vars{categories}}) {
$_->{children} = $children{$_->{ID}} || 0;
$_->{selected} = $selected{$_->{ID}} || 0;
}
if ($fetchlinks and @fetchlinks) {
# Remove CategoryID = 0 (shouldn't normally happen)
@fetchlinks = grep $_, @fetchlinks;
$catlinks->select_options("ORDER BY CategoryID, Title");
$vars{links} = $catlinks->select({ CategoryID => \@fetchlinks }, VIEWABLE)->fetchall_hashref;
%selected = map { $_ => 1 } @lid;
for (@{$vars{links}}) {
$_->{selected} = $selected{$_->{ID}} || 0;
}
}
}
print $IN->header('text/xml');
print Links::user_page('treecats.xml', \%vars);
}
1;