572 lines
24 KiB
Perl
572 lines
24 KiB
Perl
# ==================================================================
|
|
# 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;
|