# ==================================================================
# 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: Admin.pm,v 1.16 2005/03/05 01:29: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::Admin;
# ==================================================================
use strict;
use GT::SQL::Admin;
use Links qw/$DB/;
use GT::AutoLoader;
use vars  qw/@ISA $ERROR_MESSAGE $FONT $DEBUG/;

@ISA = qw/GT::SQL::Admin/;
$DEBUG         = 0;
$ERROR_MESSAGE = 'GT::SQL';
$FONT          = $GT::SQL::Admin::FONT;

# Make sure AUTOLOAD does not catch destroyed objects.
sub DESTROY {}

$COMPILE{modify_multi_records} = __LINE__ . <<'END_OF_SUB';
sub modify_multi_records {
# -------------------------------------------------------------------
# Overrides the Links table to format the category name properly.
#
    my $self   = shift;
    my $name   = $self->{table}->name;
    my $prefix = $DB->prefix;
    return $self->SUPER::modify_multi_records(@_) unless ( $name eq $prefix . 'Links');

    if (! exists $self->{cgi}->{modify}) {
        return $self->modify_error("Please select a record to modify before continuing.");
    }
# If they selected only one record to modify we still need an array ref
    ref $self->{cgi}->{modify} eq 'ARRAY' or $self->{cgi}->{modify} = [$self->{cgi}->{modify}];

# Format the cgi for inserting
    $self->format_insert_cgi;

# Hash to handle errors if there are any errors.
    my $errors = {};
    my $errcode = {};

# Need to know the names of the columns for this Table.
    my @columns = keys %{$self->{table}->cols};
    push @columns, 'CatLinks.CategoryID';

# Need to know the number of records modified
    my $rec_modified = 0;

# For through the record numbers. These are the values of the 
# check boxes
    foreach my $rec_num (@{$self->{cgi}->{modify}}) {
        my $change = {};
        foreach my $column (@columns) {
            $change->{$column} = $self->{cgi}->{"$rec_num-$column"} if exists $self->{cgi}->{"$rec_num-$column"};
        }

# Make the changes and capture any errors.
        my $ret = $self->{table}->modify($change);
        if (defined $ret) {
            $rec_modified++;
        }
        else {
            if ($self->{table}->error) {
                my $error = $self->{table}->error;
                $error =~ s/\n/<br>\n<li>/g;
                $errors->{$rec_num} = "<li>$error";
            }
            $errcode->{$rec_num} = $GT::SQL::errcode if ($GT::SQL::errcode);
        }
    }

# Return the results page with the proper arguments depending on if we got an error or not.
    return (keys %$errors) ? $self->modify_multi_results($rec_modified, $errors, $errcode) : $self->modify_multi_results($rec_modified);
}
END_OF_SUB

$COMPILE{editor_import_data_form} = __LINE__ . <<'END_OF_SUB';
sub editor_import_data_form {
# -------------------------------------------------------------------
# Allow the import to import category/link data. Only used if called with the
# Links database.
#
    my $self   = shift;
    my $name   = $self->{table}->name;
    my $prefix = $DB->prefix;
    return $self->SUPER::editor_import_data_form(@_) unless ( $name eq $prefix . 'Links');

    my $msg    = shift;
    print $self->{in}->header;
    $msg &&= qq|<FONT COLOR="red"><B>$msg</B></FONT>|;
    my $table = $self->{record};


    print $self->_start_html ( { title => "Links Table Editor: $table" });
    print $self->_header ("Links Table Editor", $msg || "Import Data to $table.");
    print $self->_start_form ( { do => 'editor_import_data', db => $self->{cgi}->{db} }, { name => 'ImportForm'});

    print qq~
        <table border=0 width=500><tr><td>
            <p><font $FONT>You can either import from a file or you can cut and paste the contents into a textarea box. If you
             have a large number of records, you should really import from a file. The first row of your input should be the 
             fully qualified column names. You must also include the Category ID and Category Name of the category the link
             will be imported to.<br>
             &nbsp;
        </td></tr></table>
        <br>
        <table border=0 width=500><tr><td>
             <p><font $FONT>
             Import data from file: <input type=text name="import-file" size=10> or from textarea box:<br>
             <textarea name="import-text" rows=3 cols=40></textarea><br>
             Use <input type=text name="import-delim" value="|" size=1> as delimiter.
             <input type=checkbox name="import-delete" value=1> Delete old data first
             <br>&nbsp;
        </tr></td></table>
    ~;
    print $self->_buttons ("Import Data into");
    print "<P>";
    print $self->_end_form;
    print $self->_prop_navbar;
    print "<P>";
    print $self->_footer;
    print $self->_end_html;

}
END_OF_SUB

$COMPILE{editor_import_data} = __LINE__ . <<'END_OF_SUB';
sub editor_import_data {
# -------------------------------------------------------------------
# Allow the import to import category/link data. Only used if called with the
# Links database.
#
    my $self   = shift;
    my $name   = $self->{table}->name;
    my $prefix = $DB->prefix;
    return $self->SUPER::editor_import_data(@_) unless ( $name eq $prefix . 'Links');
    
    my $delim  = $self->{cgi}->{'import-delim'} or return $self->editor_import_data_form ("No import delimiter specified!");
    my $file   = $self->{cgi}->{'import-file'};
    my $text   = $self->{cgi}->{'import-text'};

# Make sure there is some data to import
    $file or  $text or  return $self->editor_import_data_form ("You must enter in at least a filename or data in the textarea box.");
    $file and $text and return $self->editor_import_data_form ("Please only enter either a filename or data in the textarea box, not both.");

    $delim =~ s/\\t/\t/g;
    $delim =~ /%/ and $self->editor_import_data_form("% may not be used as a delimited.");

# Store the lines to import in @lines and the header in $header.
    my ($good_cnt, $err_cnt, $line, $line_num, @lines, @data, $error, %record, $i);
    if ($file) {
        local *FILE;
        open (FILE, "<$file") or return $self->editor_import_data_form ("Unable to open file: '$file'. Reason: $!");
        local $/;
        @lines  = split /[\r\n]+/, scalar <FILE>;
        close FILE;
    }
    else {
        @lines  = split /[\r\n]+/, $text;
    }

# Fetch the header.
    my @header = split /\Q$delim\E/, shift @lines;
    unless (grep { $_ eq ($prefix . 'Category.ID')} @header) {
        return $self->editor_import_data_form ("Unable to find Category ID column in header!");
    }

# Remove Links table prefix.
    my $full_name = $prefix . 'Links';
    @header = map { s/\Q$full_name\E\.//; $_; } @header;

    my $Links    = $DB->table('Links');
    my $CatLinks = $DB->table('CatLinks');
    my $Category = $DB->table('Category');

# Remove old data if requested.
    my $delete = $self->{cgi}->{'import-delete'};
    if ($delete) {
        $Links->delete_all    or die $GT::SQL::error; 
        $CatLinks->delete_all or die $GT::SQL::error;
    }

# Do the import.
    $good_cnt = $err_cnt = 0;

    my %link_map;

    LINE: for my $line_num (0 .. $#lines) {
        ($err_cnt > 10) and last LINE;
        $line = $lines[$line_num];
        @data = split /\Q$delim/, $line, -1;
        if ($#data != $#header) {
            $error .= "<li>" . ($line_num+2) . ": Row count: " . ($#data+1) . 
                " does not match header count: (@data) (@header)" . ($#header+1) . "\n";
            $err_cnt++;
            next LINE;
        }
        for (@data) {
            s/%([0-9a-fA-F]{2})/chr hex $1/eg;
        }
        $i = 0;
        %record = map { $data[$i] =~ s,^"|"$,,g; $header[$i] => $data[$i++] } @data;
        my $cat_id   = delete $record{$prefix . 'Category.ID'};
        my $cat_name = delete $record{$prefix . 'Category.Name'};
        unless ($Category->count({ ID => $cat_id })) {
            $cat_id = $Category->insert({ Name => $cat_name })->insert_id;
        }
        my $link_id = delete $record{ID};
        if ($link_id and $link_map{$link_id}) {
            $link_id = $link_map{$link_id};
        }
        else {
            my $count = $Links->count({ ID => $link_id });
            if ($link_id and $count) {
                if ($count) {
                    unless ($Links->update(\%record, { ID => $link_id })) {
                        $error .= "<li>" . ($line_num+2) . ": Failed to update record. Error <ul>$GT::SQL::error</ul>\n";
                        $err_cnt++;
                        next LINE;
                    }
                    $link_map{$link_id} = $link_id;
                }
                else {
                    my $old_id = $link_id;
                    my $sth    = $Links->insert(\%record);
                    unless ($sth and ($link_id = $sth->insert_id)) {
                        $error .= "<li>" . ($line_num+2) . ": Failed to add new record. Error <ul>$GT::SQL::error</ul>\n";
                        $err_cnt++;
                        next LINE;
                    }
                    $link_map{$old_id} = $link_id;
                }
            }
            else {
                my $old_id = $link_id;
                my $sth    = $Links->insert(\%record);
                unless ($sth and ($link_id = $sth->insert_id)) {
                    $error .= "<li>" . ($line_num+2) . ": Failed to add new record. Error <ul>$GT::SQL::error</ul>\n";
                    $err_cnt++;
                    next LINE;
                }
                $link_map{$old_id} = $link_id;
            }
        }
        unless ($CatLinks->count ( { LinkID => $link_id, CategoryID => $cat_id })) {
            $CatLinks->insert({ LinkID => $link_id, CategoryID => $cat_id });
        }
        $good_cnt++;
        last if ($err_cnt > 100);
    }

# Return the results.
    if ($error) {
        return $self->editor_import_data_form (($err_cnt >= 100) ?
            "Aborting, too many errors!<br><br>Rows imported: $good_cnt<br>Errors with the following rows: 
                <font size=-1><ul>$error</ul></font><br>" :
            "Rows imported: $good_cnt<br>Errors with the following rows: <font size=-1><ul>$error</ul></font><br>");
    }
    return $self->editor_import_data_form ("Rows imported: $good_cnt.");
}
END_OF_SUB

$COMPILE{editor_export_data_form} = __LINE__ . <<'END_OF_SUB';
sub editor_export_data_form {
# -------------------------------------------------------------------
# Allow the export to export category/link data. Only used if called with the
# Links database.
#
    my $self   = shift;
    my $name   = $self->{table}->name;
    my $prefix = $DB->prefix;
    return $self->SUPER::editor_export_data_form(@_) unless ( $name eq $prefix . 'Links');

    my $msg    = shift;

    print $self->{in}->header;

    $msg &&= qq|<FONT COLOR="red"><B>$msg</B></FONT>|;
    my $table = $self->{record};
    print $self->_start_html ( { title => "Table Editor: $table" });
    print $self->_header ("Table Editor", $msg || "Export Data from $table.");
    print $self->_start_form ( { do => 'editor_export_data', db => $self->{cgi}->{db} }, {name => 'ExportForm'});

    print qq~
        <table border=0 width=500><tr><td>
            <p><font $FONT>From here you can export your Links to either the screen or to 
            a file on your server. The first line of the export will be a list of the column
            headers. The last two fields is the Category ID the link is in, and the Category Name.
            If a link is in more then one category, you will get one row for each occurrence.
            </font>
        </td></tr></table>
    <br>
    <table border=0 width=500><tr><td><font $FONT>
        Export data to: <select name="export-mode"><option>file<option>screen</select> 
        filename: <input type=text name="export-file" size=10><br>
        Use <input type=text name="export-delim" value="|" size=1> as delimiter.
        </font>
    </td></tr></table>
    <br>
    ~;
    print $self->_buttons ("Export Data from");
    print "<P>";
    print $self->_end_form;
    print $self->_prop_navbar;
    print "<P>";
    print $self->_footer;
    print $self->_end_html;

}
END_OF_SUB

$COMPILE{editor_export_data} = __LINE__ . <<'END_OF_SUB';
sub editor_export_data {
# -------------------------------------------------------------------
# Allow the export to export category/link data. Only used if called with the
# Links database.
#
    my $self   = shift;
    my $name   = $self->{table}->name;
    my $prefix = $DB->prefix;
    return $self->SUPER::editor_export_data(@_) unless ( $name eq $prefix . 'Links');

    print $self->{in}->header;

    ref $self->{cgi}->{db} and return $self->error('BADARGS','FATAL', "Editor can only be called with one table, not a relation.");

    my @order = $self->{table}->ordered_columns;
    @order or return $self->editor_export_data_form("No fields selected to export (@order).");

# Add on the prefix.
    for (@order) { $_ = $prefix . 'Links.' . $_; }

# Add the ID and Category Name.
    push @order, $prefix . 'Category.ID', $prefix .'Category.Name';

    my $delim = $self->{cgi}->{'export-delim'};
    $delim = "\t" if $delim eq '\t';
    length $delim or $self->editor_export_data_form("No delimiter entered.");
    $delim =~ /%/ and $self->editor_export_data_form("% may not be used as a delimited.");

    my $screen = $self->{cgi}->{'export-mode'} ne 'file';

    local *FILE;
    if ($screen) {
        open FILE, ">&STDOUT";
        print FILE $self->{in}->header(); # print FILE to avoid STDOUT vs. FILE buffering issues
        print FILE "<html><head><title>Links Export</title></head><body><pre>";
    }
    else {
        my $filename = $self->{cgi}->{'export-file'} or return $self->editor_export_data_form("Please enter a file name!");
        open FILE, "> $filename" or return $self->editor_export_data_form("Unable to open file '$filename': $!");
    }

# Print the row header.
    print FILE join ($delim, @order), "\n";

# Print the data.
    my $db = $DB->table(qw/Links CatLinks Category/);
    my $sth = $db->select(\@order) or return $self->editor_export_data_form($GT::SQL::error);
    my $delim_re = quotemeta $delim;
    my $delim_str = join '', map sprintf("%%%02x", ord($_)), split '', $delim;
    {
        local $, = $delim;
        local $\ = "\n";
        while (my $row = $sth->fetchrow_arrayref) {
            for (@$row) {
                s{$delim_re}{$delim_str}g;
                s{%}               {%25}g;
                s{\r}                 {}g;
                s{\n}              {%0a}g;
                $_ = $self->{in}->html_escape($_) if $screen;
            }
            print FILE @$row;
        }
    }
    print FILE "</pre></body></html>" if $screen;
    return $self->editor_export_data_form("Data has been exported to: $self->{cgi}->{'export-file'}") unless $screen;
    return;
}
END_OF_SUB

sub _check_opts {
# -------------------------------------------------------------------
# Need to override this so searching for categories works.
#
    my $self = shift;
    my $sel = 0;

# Relation does not plat fare :(
    my $cols = $self->{table}->cols;
    for (keys %{$self->{cgi}}) { $sel = 1 if (($self->{cgi}->{$_} =~ /\S/) and exists $cols->{$_}) }
    if ((exists $self->{cgi}->{query} and $self->{cgi}->{query} =~ /\S/) or
        (exists $self->{cgi}->{keyword} and $self->{cgi}->{keyword} =~ /\S/)) {
            $sel = 1;
    }
    my $prefix = $DB->prefix;
    if (! $sel and ($self->{table}->name eq $prefix . 'Links') and (exists $self->{cgi}->{'CatLinks.CategoryID'})) {
        $sel = 1;
    }
    $sel or return;
    return 1;
}

sub _buttons {
# -------------------------------------------------------------------
# Adds a warning message to delete Users and Categories.
#
    my $self = shift;
    my $name = shift;
    my $prefix = GT::SQL->prefix();
    my $msg  = '';
    if (($self->{table}->name eq $prefix . "Users") and ($name eq 'Delete')) {
        $msg = qq~<p><font face="Tahoma,Arial,Helvetica" size="2"><font color="red"><b>Warning:</b></font> deleting a user will also delete all links associated with that user!</font></p>~;
    }
    if (($self->{table}->name eq $prefix . "Category") and ($name eq 'Delete')) {
        $msg = qq~<p><font face="Tahoma,Arial,Helvetica" size="2"><font color="red"><b>Warning:</b></font> deleting a category will also delete all sub categories and links in those categories!</font></p>~;
    }

    return qq~
<table border=1 cellpadding=0 cellspacing=0><tr><td align=center>
    <table border=0 width=500><tr><td align=center>$msg<center><font face="Tahoma,Arial,Helvetica" size="2"><input type=submit value="$name $self->{record}"></font></center></td></tr></table>
</td></tr></table>
    ~;
}

1;
