# ==================================================================
# Gossamer Links - enhanced directory management system
#
#   Website  : http://gossamer-threads.com/
#   Support  : http://gossamer-threads.com/scripts/support/
#   CVS Info : 087,068,085,094,083
#   Revision : $Id: Modify.pm,v 1.81 2009/03/21 11:09:27 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}) {
            $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;