410 lines
18 KiB
Perl
410 lines
18 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: Links.pm,v 1.25 2007/11/14 02:40:26 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::HTML::Links;
|
|
# ==================================================================
|
|
# Handles displaying of forms and HTML.
|
|
#
|
|
use strict;
|
|
use vars qw/@ISA/;
|
|
use GT::SQL::Display::HTML::Table;
|
|
use Links qw/:payment :objects/;
|
|
|
|
@ISA = qw/GT::SQL::Display::HTML::Table/;
|
|
|
|
my $FORM_HIDE = '^(add_form|modify_form|modify_multi_search_results|modify_multi_result_changed|modify_multi_results_err|validate)$';
|
|
my $FORM_HIDE_FIELDS = [qw/isNew isChanged isPopular Status Date_Checked/];
|
|
my $SHOW_CAT_LIST = '^(search_results|add_success|delete_search_results|modify_search_results|modify_success|modify_multi_search_results|modify_multi_results_norec)$';
|
|
my $SHOW_CAT_FORM = '^(search_form|add_form|delete_search_form|modify_form|modify_search_form|modify_multi_search_results|modify_multi_result_changed|modify_multi_results_err|validate)$';
|
|
|
|
sub display {
|
|
# -------------------------------------------------------------------
|
|
# Displays a link, but passes through the plugin system.
|
|
#
|
|
my $self = shift;
|
|
my $p = (ref $_[0] eq 'HASH') ? shift : {@_};
|
|
|
|
$PLG->dispatch('display_link', sub { return $self->_plg_display (@_); }, $p );
|
|
}
|
|
|
|
sub form {
|
|
# -------------------------------------------------------------------
|
|
# Displays a link form, but passes through the plugin system.
|
|
#
|
|
my $self = shift;
|
|
my $p = (ref $_[0] eq 'HASH') ? shift : {@_};
|
|
|
|
$PLG->dispatch('form_link', sub { return $self->_plg_form (@_); }, $p );
|
|
}
|
|
|
|
sub _plg_display {
|
|
# -------------------------------------------------------------------
|
|
# Displays a record.
|
|
#
|
|
my ($self, $opts) = @_;
|
|
$opts->{code}->{LinkOwner} ||= \&disp_username;
|
|
$opts->{code}->{ExpiryDate} ||= \&disp_expiry;
|
|
|
|
my $hidden = sub { '' };
|
|
$opts->{code}->{ExpiryCounted} ||= $hidden;
|
|
$opts->{code}->{ExpiryNotify} ||= $hidden;
|
|
$opts->{code}->{LinkExpired} ||= $hidden;
|
|
|
|
my $out = $self->SUPER::display($opts);
|
|
if ($opts->{mode} =~ /$SHOW_CAT_LIST/o) {
|
|
my $id = $opts->{values}->{ID};
|
|
if ($id) {
|
|
my $font = $self->{font};
|
|
my $output = $self->disp_categories($id);
|
|
$out .= qq~
|
|
<p><table border=1 cellpadding=0 bgcolor="#FFFFFF" cellspacing=0 width="500"><tr><td>
|
|
<table border=0 bgcolor="#FFFFFF" width="500"><tr>
|
|
<td width="20%" valign="top"><font $font>Categories</td>
|
|
<td width="80%"><font $font>$output</td>
|
|
</tr></table>
|
|
</td></tr></table>
|
|
~;
|
|
}
|
|
}
|
|
return $out;
|
|
}
|
|
|
|
sub _plg_form {
|
|
# -------------------------------------------------------------------
|
|
# Displays a form.
|
|
#
|
|
my ($self, $opts) = @_;
|
|
|
|
my $link_id = $opts->{values}->{ID} || $self->{input}->{ID};
|
|
|
|
# Hide fields we don't want to show on add/modify forms.
|
|
if ($opts->{mode} and $opts->{mode} =~ /$FORM_HIDE/o) {
|
|
$opts->{hide} ||= [];
|
|
push @{$opts->{hide}}, @{$FORM_HIDE_FIELDS};
|
|
}
|
|
|
|
$opts->{code}->{ExpiryDate} ||= \&form_expiry;
|
|
|
|
# Add javascript to display the original values for text/textarea columns
|
|
if ($opts->{show_diff} and $link_id) {
|
|
my $current = $DB->table('Links')->select({ ID => $link_id })->fetchrow_hashref;
|
|
my $cols = $DB->table('Links')->cols;
|
|
my $textarea = sub {
|
|
my ($self, $opts, $values, $col) = @_;
|
|
|
|
my $field_name = $self->{multiple} ? "$self->{multiple}-$col" : $col;
|
|
my $display_name = (exists $self->{cols}->{$col}->{form_display} and length $self->{cols}->{$col}->{form_display})
|
|
? $self->{cols}->{$col}->{form_display} : $col;
|
|
my $value = $values->{$col};
|
|
my $disp = $opts->{form_type} eq 'TEXT' ? 'text' : 'textarea';
|
|
|
|
my $ret = qq|<tr $self->{tr}><td $self->{td} width='30%'><font $self->{col_font}><a href="javascript:toggleOriginal('$field_name-original')" title="Show/Hide original $display_name value">$display_name</a></font></td><td $self->{td} width='70%'><font $self->{val_font}>|;
|
|
$ret .= $self->$disp({ name => $field_name, def => $opts, value => (defined $value ? $value : '')});
|
|
$ret .= qq|</font></td></tr>\n<tr id="$field_name-original" style="display: none" $self->{tr}><td $self->{td} width="30%"><font $self->{col_font}>Original $display_name</font></td><td $self->{td} width="70%"><font $self->{val_font}>|;
|
|
if ($opts->{form_type} eq 'TEXT') {
|
|
$ret .= qq|<input type="text" value="$current->{$col}" size="| . ($opts->{form_size} || 20) . qq|" readonly="readonly" />|;
|
|
}
|
|
else {
|
|
my ($cols, $rows) = ref $opts->{form_size} ? (@{$opts->{form_size}}) : ($opts->{form_size} || 20, 4);
|
|
$ret .= qq|<textarea rows="$rows" cols="$cols" readonly="readonly">$current->{$col}</textarea>|
|
|
}
|
|
$ret .= "</font></td></tr>\n";
|
|
};
|
|
|
|
COL: for my $col (keys %$current) {
|
|
next if !$cols->{$col}->{form_type} or ($cols->{$col}->{form_type} ne 'TEXT' and $cols->{$col}->{form_type} ne 'TEXTAREA');
|
|
# Skip hidden fields
|
|
for (@{$opts->{hide}}) {
|
|
next COL if $_ eq $col;
|
|
}
|
|
|
|
if ((not defined $opts->{values}->{$col} or $current->{$col} ne $opts->{values}->{$col}) and not $opts->{code}->{$col}) {
|
|
$opts->{code}->{$col} = $textarea;
|
|
}
|
|
}
|
|
}
|
|
|
|
# Display the form.
|
|
my $out = $self->SUPER::form($opts);
|
|
|
|
# Display the category select box.
|
|
if ($opts->{mode} and $opts->{mode} =~ /$SHOW_CAT_FORM/o) {
|
|
my $name = $opts->{multiple} ? "$opts->{multiple}-CatLinks.CategoryID" : 'CatLinks.CategoryID';
|
|
my $id = $opts->{values}->{$name} || $self->{input}->{$name};
|
|
$id = (ref $id eq 'ARRAY') ? $id : $id ? [$id] : [];
|
|
my $font = $self->{font};
|
|
my ($output, $h);
|
|
|
|
# Add javascript to display the original categories
|
|
my $cats_modified;
|
|
if ($opts->{show_diff} and @$id and $link_id) {
|
|
my $ccl = $DB->table('Category', 'CatLinks');
|
|
$ccl->select_options("ORDER BY CategoryID");
|
|
my $sth = $ccl->select('CategoryID', 'Full_Name', { LinkID => $link_id });
|
|
my (@cid, @cats);
|
|
while (my $cat = $sth->fetchrow_hashref) {
|
|
push @cid, $cat->{CategoryID};
|
|
push @cats, $cat->{Full_Name};
|
|
}
|
|
if (@$id == @cid) {
|
|
my @sorted = sort { $a > $b } @$id;
|
|
for (my $i = 0; $i < @cid; $i++) {
|
|
if ($cid[$i] != $sorted[$i]) {
|
|
$cats_modified = join "\n", sort @cats;
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
$cats_modified = join "\n", sort @cats;
|
|
}
|
|
}
|
|
|
|
# Display the category using treecats
|
|
if ($CFG->{db_gen_category_list} == 2) {
|
|
my $name = $opts->{multiple} ? "$opts->{multiple}-CatLinks.CategoryID" : 'CatLinks.CategoryID';
|
|
my $jsname = $opts->{multiple} ? "tc$opts->{multiple}" : 'tc';
|
|
if (!@$id and $link_id) {
|
|
$h = $self->{db}->get_categories($link_id);
|
|
for (keys %$h) {
|
|
push @$id, $_;
|
|
}
|
|
}
|
|
$out .= qq~<p><table border=1 cellpadding=0 bgcolor="#FFFFFF" cellspacing=0><tr><td>~ unless exists $opts->{extra_table} and $opts->{extra_table} == 0;
|
|
$out .= qq~
|
|
<table border=0 bgcolor="#FFFFFF" width="500"><tr>
|
|
<td width="30%" valign="top"><font $font>~;
|
|
$out .= qq|<a href="javascript:toggleOriginal('$name-original')" title="Show/Hide original Category value">| if $cats_modified;
|
|
$out .= "Categories";
|
|
$out .= qq|</a>| if $cats_modified;
|
|
for (@$id) {
|
|
$out .= qq|<input type="hidden" name="$name" value="$_" />|;
|
|
}
|
|
$out .= qq~</td>
|
|
<td>
|
|
<script type="text/javascript" src="$CFG->{build_static_url}/treecats.js"></script>
|
|
<link type="text/css" rel="stylesheet" href="$CFG->{build_static_url}/admin/treecats.css" />
|
|
<font $font><div id="$jsname"></div></font>
|
|
<script type="text/javascript">var $jsname = new treecats({ workspace : '$jsname', objName : '$jsname', inputName : '$name', selectionMode : 'multiple', cgiURL : '$CFG->{db_cgi_url}', imageURL : '$CFG->{build_static_url}/admin' }); $jsname.load();</script>
|
|
</td>
|
|
</tr></table>
|
|
~;
|
|
$out .= qq~</p></td></tr></table>~ unless exists $opts->{extra_table} and $opts->{extra_table} == 0;
|
|
}
|
|
# Display category as a select box.
|
|
elsif ($CFG->{db_gen_category_list}) {
|
|
if (!@$id and $link_id) {
|
|
$h = $self->{db}->get_categories($link_id);
|
|
$output = $self->get_categories_with_html([keys %$h], $name);
|
|
}
|
|
else {
|
|
$output = $self->get_categories_with_html($id, $name);
|
|
}
|
|
$out .= "<p>";
|
|
$out .= qq~<table border=1 cellpadding=0 bgcolor="#FFFFFF" cellspacing=0><tr><td>~ unless exists $opts->{extra_table} and $opts->{extra_table} == 0;
|
|
$out .= qq~
|
|
<table border=0 bgcolor="#FFFFFF" width="500"><tr>
|
|
<td width="20%" valign="top"><font $font>~;
|
|
$out .= qq|<a href="javascript:toggleOriginal('$name-original')" title="Show/Hide original Category value">| if $cats_modified;
|
|
$out .= "Categories";
|
|
$out .= qq|</a>| if $cats_modified;
|
|
$out .= qq~</td>
|
|
<td width="80%"><font $font>$output</td>
|
|
</tr></table>
|
|
~;
|
|
$out .= qq~</td></tr></table>~ unless exists $opts->{extra_table} and $opts->{extra_table} == 0;
|
|
}
|
|
# Display category as a textarea box.
|
|
else {
|
|
my ($vals);
|
|
if (@$id) {
|
|
my $db = $DB->table('Category');
|
|
foreach (@$id) {
|
|
if (/^\d+$/) {
|
|
$vals .= $db->get_name_from_id($_) . "\n";
|
|
}
|
|
else {
|
|
$vals .= $_ . "\n";
|
|
}
|
|
}
|
|
}
|
|
elsif ($link_id) {
|
|
$h = $self->{db}->get_categories($link_id);
|
|
$vals = join("\n", sort values %$h);
|
|
}
|
|
else {
|
|
$vals = '';
|
|
}
|
|
$out .= "<p>";
|
|
$out .= qq~<table border=1 cellpadding=0 bgcolor="#FFFFFF" cellspacing=0><tr><td>~ unless exists $opts->{extra_table} and $opts->{extra_table} == 0;
|
|
$out .= qq~
|
|
<table border=0 bgcolor="#FFFFFF" width="500"><tr>
|
|
<td width="20%" valign="top"><font $font>~;
|
|
$out .= qq|<a href="javascript:toggleOriginal('$name-original')" title="Show/Hide original Category value">| if $cats_modified;
|
|
$out .= "Categories";
|
|
$out .= qq|</a>| if $cats_modified;
|
|
$out .= qq~<br><font size=1>One per line</font></td>
|
|
<td width="80%"><font $font><textarea rows="3" cols="50" name="$name">$vals</textarea></td>
|
|
</tr></table>
|
|
~;
|
|
$out .= qq~</td></tr></table>~ unless exists $opts->{extra_table} and $opts->{extra_table} == 0;
|
|
|
|
}
|
|
|
|
if ($cats_modified) {
|
|
$out .= qq~
|
|
<table border=0 bgcolor="#FFFFFF" width="500" id="$name-original" style="display: none"><tr>
|
|
<td width="20%" valign="top"><font $font>Original Categories</font></td>
|
|
<td width="80%"><font $font><textarea rows="3" cols="50" readonly="readonly">$cats_modified</textarea></td>
|
|
</tr></table>
|
|
~;
|
|
}
|
|
}
|
|
return $out;
|
|
}
|
|
|
|
sub disp_username {
|
|
# -------------------------------------------------------------------
|
|
# Display the username with links to edit.
|
|
#
|
|
my ($self, $col, $rec) = @_;
|
|
my $val = $rec->{LinkOwner};
|
|
my $val_e = GT::CGI->escape($val);
|
|
my $font = $self->{font};
|
|
return qq~
|
|
<tr><td><font $font>$col->{form_display}</font></td><td><font $font>$val <font size=1><a href="admin.cgi?db=Users&do=modify_form&modify=1&1-Username=$val_e&ww=1">edit</a></font></font></td></tr>
|
|
~;
|
|
}
|
|
|
|
sub disp_categories {
|
|
# -------------------------------------------------------------------
|
|
# Displays a list of categories for the form.
|
|
#
|
|
my $self = shift;
|
|
my $id = shift;
|
|
my $cat = $self->{db}->get_categories ($id);
|
|
my $out = '';
|
|
foreach my $id (sort { lc $cat->{$a} cmp lc $cat->{$b} } keys %$cat) {
|
|
$out .= "$id: $cat->{$id}<br>\n";
|
|
}
|
|
return $out;
|
|
}
|
|
|
|
sub disp_expiry {
|
|
# -------------------------------------------------------------------
|
|
#
|
|
my ($self, $col, $rec) = @_;
|
|
my $val = $rec->{ExpiryDate};
|
|
my $name = $col->{form_display};
|
|
my $font = $self->{font};
|
|
my $td = $self->{td};
|
|
|
|
my $out = qq|<tr><td $td><font $font>$name</font></td><td $td><font $font>|;
|
|
if ($val == UNLIMITED) {
|
|
$out .= "<i>Never</i>";
|
|
}
|
|
elsif ($val == UNPAID) {
|
|
$out .= "<i>Awaiting Payment</i>";
|
|
}
|
|
elsif ($val == FREE) {
|
|
$out .= "<i>No Payment Required (free)";
|
|
if ($rec->{LinkExpired}) {
|
|
require GT::Date;
|
|
$out .= " - Payment Expired " . GT::Date::date_get($rec->{LinkExpired}, '%yyyy%/%m%/%d% %HH%:%MM%:%ss%');
|
|
}
|
|
$out .= "</i>";
|
|
}
|
|
elsif ($val == 0) {
|
|
$out .= "<i>Invalid Date (0)!</i>";
|
|
}
|
|
else {
|
|
require GT::Date;
|
|
$out .= GT::Date::date_get($val, '%yyyy%/%m%/%d% %HH%:%MM%:%ss%');
|
|
}
|
|
$out .= qq|</font></td>|;
|
|
return $out;
|
|
}
|
|
|
|
sub form_expiry {
|
|
# -------------------------------------------------------------------
|
|
#
|
|
my ($self, $col, $rec) = @_;
|
|
require GT::Date;
|
|
my $val = $rec->{ExpiryDate};
|
|
my $name = $col->{form_display};
|
|
my $font = $self->{font};
|
|
my $td = $self->{td};
|
|
my $got_date = $val && $val < UNLIMITED && $val > 0;
|
|
($got_date and $val !~ m|^\d+$|) and $val = Links::date_to_time($val);
|
|
my $multiple = $self->{multiple} ? "$self->{multiple}-" : '';
|
|
$name .= '<br><i><font size=-2>Dates can be entered in the following formats: YYYY-MM-DD, YYYY/MM/DD, YYYY/MM/DD HH:MM:SS</font></i>';
|
|
my $out = qq|<tr><td $td><font $font>$name</font></td><td $td><font $font><input type="hidden" name="${multiple}ExpiryDate" value="$val" id="${multiple}ExpiryDate">|;
|
|
$out .= qq|<input type="radio" name="${multiple}pe_radio" onclick="document.getElementById('${multiple}ExpiryDate').value = document.getElementById('${multiple}pe_date').value"|;
|
|
$out .= qq| checked| if $got_date;
|
|
$out .= qq|><input type="text" name="${multiple}pe_date" id="${multiple}pe_date" onchange="document.getElementById('${multiple}ExpiryDate').value = document.getElementById('${multiple}pe_date').value"|;
|
|
$out .= qq| value="| . GT::Date::date_get($val, '%yyyy%/%m%/%d% %HH%:%MM%:%ss%') . qq|"| if $got_date;
|
|
$out .= qq|><br><input type="radio" name="${multiple}pe_radio" onclick="document.getElementById('${multiple}ExpiryDate').value = | . UNLIMITED . qq|"|;
|
|
$out .= qq| checked| if $val && $val == UNLIMITED;
|
|
$out .= qq|> Never<br><input type="radio" name="${multiple}pe_radio" onclick="document.getElementById('${multiple}ExpiryDate').value = | . UNPAID . qq|"|;
|
|
$out .= qq| checked| if $val && $val == UNPAID;
|
|
$out .= qq|> Awaiting Payment<br><input type="radio" name="${multiple}pe_radio" onclick="document.getElementById('${multiple}ExpiryDate').value = | . FREE . qq|"|;
|
|
$out .= qq| checked| if $val && $val == FREE || !$val;
|
|
$out .= qq|> No Payment Required (free)|;
|
|
$out .= qq| - Expired | . GT::Date::date_get($rec->{LinkExpired}, '%yyyy%/%m%/%d% %HH%:%MM%:%ss%') if $val and $val == FREE and $rec->{LinkExpired};
|
|
$out .= qq|</font></td>|;
|
|
|
|
if ($self->{mode} =~ /search/ or (exists $self->{input}->{action} and $self->{input}->{action} =~ /search/)) { # Hack to get this to show up on the Browser search
|
|
$out .= qq|<td $td><select name="${multiple}ExpiryDate-opt"><option value="=">Exact Match</option><option value=">">Greater Than</option><option value="<">Less Than</option><option value="<>">Not Equal</option></select></td>|;
|
|
}
|
|
return $out;
|
|
}
|
|
|
|
sub get_all_categories {
|
|
# -------------------------------------------------------------------
|
|
# Returns a select box of all categories.
|
|
#
|
|
my $self = shift;
|
|
my $id = shift;
|
|
my $name = shift || 'CatLinks.CategoryID';
|
|
my $mult = shift || 5;
|
|
my $db = $DB->table ('Category');
|
|
my $sth = $db->select ( ['ID', 'Full_Name'] );
|
|
my %res = ();
|
|
while (my ($id, $name) = $sth->fetchrow_array) {
|
|
$res{$id} = $name;
|
|
}
|
|
return $self->select ( { name => $name, values => \%res, value => $id, blank => 0, multiple => $mult, sort => sub { lc $_[0] cmp lc $_[1] } } );
|
|
}
|
|
|
|
sub get_categories_with_html {
|
|
# -------------------------------------------------------------------
|
|
# Returns select list, and adds which categories are selected as text.
|
|
#
|
|
my ($self, @param) = @_;
|
|
my $select = $self->get_all_categories(@param);
|
|
my $output = '';
|
|
my @vals = ref $param[0] ? @{$param[0]} : ($param[0]);
|
|
if (@vals) {
|
|
my $db = $DB->table ('Category');
|
|
foreach my $id (@vals) {
|
|
next unless ($id and $id =~ /^\d+$/);
|
|
my $name_r = $db->get ($id, 'ARRAY', ['Full_Name']);
|
|
$output .= $name_r->[0] . "<BR>";
|
|
}
|
|
}
|
|
$output .= $select;
|
|
return $output;
|
|
}
|
|
|
|
1;
|