First pass at adding key files
This commit is contained in:
dsainty
@ -0,0 +1,170 @@
|
||||
# ==================================================================
|
||||
# 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: Category.pm,v 1.14 2007/09/25 06:19:32 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::Category;
|
||||
# ==================================================================
|
||||
# Handles displaying of forms and HTML.
|
||||
#
|
||||
use strict;
|
||||
use vars qw/@ISA/;
|
||||
use Links qw/:payment :objects/;
|
||||
use GT::SQL::Display::HTML::Table;
|
||||
|
||||
@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';
|
||||
my $FORM_HIDE_FIELDS = [qw/Full_Name Number_of_Links Direct_Links Has_New_Links Has_Changed_Links Newest_Link Timestmp/];
|
||||
|
||||
sub display {
|
||||
# -------------------------------------------------------------------
|
||||
# Displays a category, but passes through the plugin system.
|
||||
#
|
||||
my $self = shift;
|
||||
my $p = (ref $_[0] eq 'HASH') ? shift : {@_};
|
||||
|
||||
$PLG->dispatch('display_category', sub { return $self->_plg_display(@_); }, $p);
|
||||
}
|
||||
|
||||
sub form {
|
||||
# -------------------------------------------------------------------
|
||||
# Displays a category form, but passes through the plugin system.
|
||||
#
|
||||
my $self = shift;
|
||||
my $p = (ref $_[0] eq 'HASH') ? shift : {@_};
|
||||
|
||||
$PLG->dispatch('form_category', sub { return $self->_plg_form(@_); }, $p);
|
||||
}
|
||||
|
||||
sub _plg_display {
|
||||
# -------------------------------------------------------------------
|
||||
# Displays a record.
|
||||
#
|
||||
my ($self, $opts) = @_;
|
||||
$opts->{hide} ||= [];
|
||||
|
||||
if (!exists $opts->{code}->{FatherID} and !grep { $_ eq 'FatherID' } @{$opts->{hide}}) {
|
||||
$opts->{code}->{FatherID} = \&disp_fatherid_html
|
||||
}
|
||||
|
||||
push @{$opts->{hide}}, qw/Full_Name/;
|
||||
$CFG->{payment}->{enabled} or push @{$opts->{hide}}, 'Payment_Mode';
|
||||
|
||||
my $out = $self->SUPER::display($opts);
|
||||
|
||||
my $id = $opts->{values}->{ID};
|
||||
if ($CFG->{payment}->{enabled} and $id and $opts->{values}->{Payment_Mode} >= OPTIONAL) {
|
||||
my $font = $self->{font};
|
||||
$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="100%" valign="top" align="center"><font $font><a href="admin.cgi?do=page;page=payment_cat_price.html;ID=$id;not_global=1">Add/Update payment terms for this category</a></td>
|
||||
</tr></table>
|
||||
</td></tr></table>
|
||||
~;
|
||||
}
|
||||
return $out;
|
||||
}
|
||||
|
||||
sub _plg_form {
|
||||
# -------------------------------------------------------------------
|
||||
# Displays a form.
|
||||
#
|
||||
my ($self, $opts) = @_;
|
||||
$opts->{hide} ||= [];
|
||||
|
||||
if ($opts->{mode} and $opts->{mode} =~ /$FORM_HIDE/o) {
|
||||
push @{$opts->{hide}}, @{$FORM_HIDE_FIELDS};
|
||||
}
|
||||
|
||||
if (!exists $opts->{code}->{FatherID} and !grep { $_ eq 'FatherID' } @{$opts->{hide}}) {
|
||||
$opts->{code}->{FatherID} = \&disp_fatherid_form;
|
||||
}
|
||||
|
||||
$CFG->{payment}->{enabled} or push @{$opts->{hide}}, 'Payment_Mode';
|
||||
|
||||
return $self->SUPER::form($opts);
|
||||
}
|
||||
|
||||
sub select {
|
||||
# -------------------------------------------------------------------
|
||||
# Override Payment_Mode select field in add form.
|
||||
#
|
||||
my ($self, $opts) = @_;
|
||||
$CFG->{payment}->{enabled} and $opts->{name} eq 'Payment_Mode'
|
||||
and $self->{input}->{do} and ($self->{input}->{do} eq 'add_form' or $self->{input}->{do} eq 'modify_form')
|
||||
and $opts->{blank} = 0;
|
||||
return $self->SUPER::select($opts);
|
||||
}
|
||||
|
||||
sub disp_fatherid_form {
|
||||
# -------------------------------------------------------------------
|
||||
# Display the list of subcategories as either a drop down list of a text box.
|
||||
#
|
||||
my ($self, $col, $rec) = @_;
|
||||
my $font = $self->{font};
|
||||
my $out;
|
||||
my $form_name = $self->{multiple} ? "$self->{multiple}-FatherID" : 'FatherID';
|
||||
|
||||
if ($CFG->{db_gen_category_list} == 2) {
|
||||
if ($rec->{FatherID}) {
|
||||
$out .= qq|<input type="hidden" name="FatherID" value="$rec->{FatherID}" />|;
|
||||
}
|
||||
$out .= qq|<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" />
|
||||
<input type="hidden" name="FatherID-opt" value="=" />
|
||||
<tr><td valign="top"><font $font>Subcategory of</font></td><td><font $font><div id="treecats"></div></font></td></tr>
|
||||
<script type="text/javascript">var tc = new treecats({ selectionRequired : false, inputName : 'FatherID', cgiURL : '$CFG->{db_cgi_url}', imageURL : '$CFG->{build_static_url}/admin' }, { noSelection : 'Root', rootText : 'Root' }); tc.load();</script>\n|;
|
||||
}
|
||||
elsif ($CFG->{db_gen_category_list}) {
|
||||
my $sth = $self->{db}->select(["DISTINCT Full_Name, ID"]);
|
||||
my %names;
|
||||
if ($sth) {
|
||||
while (my ($name, $id) = $sth->fetchrow_array) {
|
||||
$names{$id} = $name;
|
||||
}
|
||||
}
|
||||
$names{0} = '--Root--';
|
||||
my $select = $self->select({ name => $form_name, values => \%names, blank => 1, sort => sub { lc $_[0] cmp lc $_[1] }, value => defined $rec->{FatherID} ? $rec->{FatherID} : "" });
|
||||
$out = qq~
|
||||
<tr><td valign=top><font $font>Subcategory of</font></td><td><font $font>$select<input type=hidden name="FatherID-opt" value="="></td></tr>
|
||||
~;
|
||||
}
|
||||
else {
|
||||
my $value = $rec->{FatherID} || '';
|
||||
if ($value =~ /^\d+$/) {
|
||||
my $sth = $self->{db}->select('Full_Name', { ID => $value });
|
||||
if ($sth) {
|
||||
($value) = $sth->fetchrow_array;
|
||||
}
|
||||
}
|
||||
$out = qq~
|
||||
<tr><td><font $font>Full Sub Category<br><font size=1>Separated with /'s</font></font></td><td><input type=text size="40" name="$form_name" value="$value"></td></tr>
|
||||
~;
|
||||
}
|
||||
return $out;
|
||||
}
|
||||
|
||||
sub disp_fatherid_html {
|
||||
# -------------------------------------------------------------------
|
||||
# Display the father.
|
||||
#
|
||||
my ($self, $col, $rec) = @_;
|
||||
my ($parent) = $rec->{Full_Name} =~ m,^(.*)/[^/]+$,;
|
||||
my $font = $self->{font};
|
||||
$parent ||= 'Root';
|
||||
return qq~
|
||||
<tr><td><font $font>Subcategory of</font></td><td><font $font>$parent</td></tr>
|
||||
~;
|
||||
}
|
||||
|
||||
1;
|
||||
409
site/slowtwitch.com/cgi-bin/articles/admin/Links/HTML/Links.pm
Normal file
409
site/slowtwitch.com/cgi-bin/articles/admin/Links/HTML/Links.pm
Normal file
@ -0,0 +1,409 @@
|
||||
# ==================================================================
|
||||
# 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;
|
||||
101
site/slowtwitch.com/cgi-bin/articles/admin/Links/HTML/Users.pm
Normal file
101
site/slowtwitch.com/cgi-bin/articles/admin/Links/HTML/Users.pm
Normal file
@ -0,0 +1,101 @@
|
||||
# ==================================================================
|
||||
# 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: Users.pm,v 1.4 2007/03/22 22:05:44 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::Users;
|
||||
# ==================================================================
|
||||
# Handles displaying of forms and HTML.
|
||||
#
|
||||
use strict;
|
||||
use vars qw/@ISA/;
|
||||
use Links qw/:objects/;
|
||||
use GT::SQL::Display::HTML::Table;
|
||||
|
||||
@ISA = qw/GT::SQL::Display::HTML::Table/;
|
||||
|
||||
sub display {
|
||||
# -------------------------------------------------------------------
|
||||
# Displays a link, but passes through the plugin system.
|
||||
#
|
||||
my $self = shift;
|
||||
my $p = ref $_[0] eq 'HASH' ? shift : {@_};
|
||||
|
||||
$PLG->dispatch('display_user', sub { $self->SUPER::display(@_) }, $p);
|
||||
}
|
||||
|
||||
sub form {
|
||||
# -------------------------------------------------------------------
|
||||
# Displays a user form, but passes through the plugin system.
|
||||
#
|
||||
my $self = shift;
|
||||
my $p = (ref $_[0] eq 'HASH') ? shift : {@_};
|
||||
|
||||
$PLG->dispatch('form_user', sub { return $self->SUPER::form(@_) }, $p);
|
||||
}
|
||||
|
||||
sub _display {
|
||||
# -------------------------------------------------------------------
|
||||
# Adds on a box with quick links to the users links.
|
||||
#
|
||||
my ($self, $opts) = @_;
|
||||
my $user = $opts->{values}->{Username};
|
||||
my $output = '';
|
||||
|
||||
# If we are modifying, then add a hidden field for the original record.
|
||||
if ($opts->{mode} eq 'modify_form') {
|
||||
$opts->{code}->{Username} ||= \&disp_username;
|
||||
my $user_q = GT::CGI->html_escape($user);
|
||||
$output .= qq~<input type="hidden" name="orig_username" value="$user_q">~;
|
||||
}
|
||||
else {
|
||||
delete $self->{code}->{Username};
|
||||
}
|
||||
$output .= $self->SUPER::_display($opts);
|
||||
if ($user) {
|
||||
my $link_db = $DB->table('Links');
|
||||
my $count = $link_db->count({ LinkOwner => $user });
|
||||
my $url = GT::CGI->url({ query_string => 0 });
|
||||
my $user_q = GT::CGI->escape($user);
|
||||
$output .= <<HTML;
|
||||
<p>
|
||||
<table border=1 cellpadding=0 bgcolor="#FFFFFF" cellspacing=0 width="500"><tr><td>
|
||||
<table border=0 bgcolor="#FFFFFF" width="500"><tr>
|
||||
<td><font face="Tahoma,Arial,Helvetica" size="2">
|
||||
Links ($count):
|
||||
<a href="$url?db=Links&do=search_results&LinkOwner=$user_q&ww=1">View</a> |
|
||||
<a href="$url?db=Links&do=modify_search_results&LinkOwner=$user_q&ww=1">Modify</a> |
|
||||
<a href="$url?db=Links&do=delete_search_results&LinkOwner=$user_q&ww=1">Delete</a>
|
||||
</font></td>
|
||||
</tr></table>
|
||||
</td></tr></table>
|
||||
HTML
|
||||
}
|
||||
return $output;
|
||||
}
|
||||
|
||||
sub disp_username {
|
||||
# -------------------------------------------------------------------
|
||||
# Display the username with links to edit.
|
||||
#
|
||||
my ($self, $col, $rec) = @_;
|
||||
my $val = $rec->{Username};
|
||||
my $val_e = GT::CGI->html_escape($val);
|
||||
my $font = $self->{font};
|
||||
return <<HTML;
|
||||
<tr>
|
||||
<td><font $font>Username</font></td>
|
||||
<td><font $font><input type="text" name="Username" value="$val_e" size="20"></font></td>
|
||||
</tr>
|
||||
HTML
|
||||
}
|
||||
|
||||
1;
|
||||
Reference in New Issue
Block a user