Wizard.pm 0000644 0001773 0000373 00000002220 10130126111 012617 0 ustar posters posters # ==================================================================
# Auto Generated Plugin Configuration - Needed for Web Based Creator.
#
# Plugins::Bad_Link
# Author : UltraNerds.com
# Version : 2.2.0
# Updated : Sun Oct 3 18:52:44 2004
#
# ==================================================================
#
package Plugins::Bad_Link;
# ==================================================================
use strict;
use vars qw/$WIZARD/;
$WIZARD = {
'install' => '',
'files' => [
[
'bad_link.cgi',
'user_cgi'
]
],
'name' => 'Bad_Link',
'menu' => [
[
'About',
'admin.cgi?do=plugin&plugin=Bad_Link&func=about'
]
],
'uninstall' => '',
'hooks' => [],
'meta' => {
'version' => '2.2.0',
'url' => 'http://ultranerds.com',
'prog_ver' => '2.2.0',
'author' => 'UltraNerds.com',
'license' => 'Other',
'description' => 'Bad link reporting tool. Modified for Links 2.2.0, and should work under mod_perl.'
},
'user' => [],
'install_code' => '',
'uninstall_code' => ''
};
1;
bad_link.cgi 0000644 0001773 0000373 00000002075 10130126341 013265 0 ustar posters posters #!/usr/local/bin/perl
# ==================================================================
# Links SQL - enhanced directory management system
#
# Website : http://gossamer-threads.com/
# Support : http://gossamer-threads.com/scripts/support/
# CVS Info : 087,071,085,088,086
# Revision : $Id: jump.cgi,v 1.28 2004/05/03 22:30:51 jagerman 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.
# ==================================================================
use strict;
use lib '/home/posters/posterlist.com/cgi-bin/admin';
use Links qw/$CFG/;
use Plugins::Bad_Link;
local $SIG{__DIE__} = \&Links::fatal;
Links::init('/home/posters/posterlist.com/cgi-bin/admin');
Links::init_user();
if (GT::Plugins->dispatch ($CFG->{admin_root_path} . '/Plugins', 'check_request', \&Links::check_request)) {
GT::Plugins->dispatch ($CFG->{admin_root_path} . '/Plugins', 'handle_jump', \&Plugins::Bad_Link::handle);
}
Install.pm 0000644 0001773 0000373 00000016405 10130126354 013010 0 ustar posters posters # ==================================================================
# Plugins::Bad_Link - Auto Generated Install Module
#
# Plugins::Bad_Link
# Author : UltraNerds.com
# Version : 2.2.0
# Updated : Sun Oct 3 18:52:44 2004
#
# ==================================================================
#
package Plugins::Bad_Link;
# ==================================================================
use strict;
use vars qw/$VERSION $DEBUG $NAME $META/;
use GT::Base;
use GT::Plugins qw/STOP CONTINUE/;
use Links qw/$CFG $IN $DB/;
$VERSION = '2.2.0';
$DEBUG = 0;
$NAME = 'Bad_Link';
# Inhert from base class for debug and error methods
@Plugins::Bad_Link::ISA = qw(GT::Base);
$META = {
'version' => '2.2.0',
'url' => 'http://ultranerds.com',
'prog_ver' => '2.2.0',
'author' => 'UltraNerds.com',
'license' => 'Copyrighted',
'description' => qq|
# ==============================================
# Bad Link - v. $VERSION
# ==============================================
This is a report bad link script -- to allow users to report links that are bad.
\n
This version works with Links SQL 2.1.1 and above.
|,
};
sub pre_install {
# -----------------------------------------------------------------------------
# This function displays an HTML formatted message that will display any
# instructions/information to the user before they install the plugin.
#
my $inst_msg = qq| This will install the Bad_Link script and templates.
It will also create a new table to track bad links.
This will be the name of the Bad_Link table.:
After the plug-in installs, check the HELP file for how to set
up the links _AND_ you must EDIT the options to customize the
look of certain things.
|;
return $inst_msg;
}
sub pre_uninstall {
# -----------------------------------------------------------------------------
# This function displays an HTML formatted message that will display any
# instructions/information to the user before they remove the plugin.
#
my $uninst_msg = '';
return $uninst_msg;
}
sub install {
# -----------------------------------------------------------------------------
# This function does the actual installation. Its first argument is a plugin
# manager which you can use to register hooks, install files, add menu options,
# etc. The second argument is a GT::Tar object which you can use to access any
# files in your plugin module.
#
# You should return an HTML formatted string that will be displayed to the
# user.
#
# If there is an error, return undef, and set the error message in
# $Plugins::Bad_Link::error
#
my ($mgr, $tar) = @_;
my $error = '';
my $message = '';
use GT::SQL::Creator;
use GT::SQL::Table;
my $table_name = $IN->{'table_name'};
($table_name) || ($table_name = 'Bad_Link');
my $new_table = $DB->creator('Bad_Link');
$new_table->cols (
LinkID => { pos => 1, type => 'INT', size => '11', not_null => 1, default => 0 },
URL => { pos => 2, type => 'VARCHAR', size => '150', not_null => 1 },
Title => { pos => 3, type => 'VARCHAR', size => '150', not_null => 1 },
Status => { pos => 4, type => 'VARCHAR', size => '255', default => 'Pending' },
TimeCheck => { pos => 5, type => 'TIMESTAMP', size => '14' },
IP => { pos => 6, type => 'VARCHAR', size => '15' }
);
$new_table->pk ( 'LinkID' );
$new_table->fk ( { Links => { LinkID => 'ID' } });
if (! $new_table->create()) {
$GT::SQL::errcode ||= ''; #silence -w, ugh.
$GT::SQL::errcode eq 'TBLEXISTS' ? ($message = "Could not create table $table_name (table already exists)\n") :
($error = "Could not create table $table_name: $GT::SQL::error)");
$new_table->set_defaults();
$new_table->save_schema();
};
# The following section will unarchive attached files into the
# proper location.
my $cgi_file_name = 'bad_link.cgi';
my $file;
####################################################
# Copying bad_link.cgi to user_cgi directory.
$file = $tar->get_file ($cgi_file_name);
# Get the entire code as a string.
my $code = $file->body_as_string;
# Replace the path to perl with the users perl.
$code =~ s/^#!(.*)/#!$CFG->{path_to_perl}/;
# Replace the use lib with the users admin directory.
$code =~ s/use lib '[^']+'/use lib '$CFG->{admin_root_path}'/;
$code =~ s,/path/to/links/admin,$CFG->{admin_root_path},g;
$file->body ($code);
# Set the name of the file
$file->name ("$CFG->{admin_root_path}/../bad_link.cgi");
unless ($file->write) {
$Plugins::Bad_Link::error = "Unable to extract file: '$CFG->{admin_root_path}/../bad_link.cgi' ($GT::Tar::error)";
return;
}
# Set permissions
chmod (0755, $file->name);
###################################################
# Copying bad_link.html to user_cgi directory.
$file = $tar->get_file ('bad_link.html');
$file->name ("$CFG->{admin_root_path}/templates/default/bad_link.html");
unless ($file->write) {
$Plugins::Bad_Link::error = "Unable to extract file: '$CFG->{admin_root_path}/templates/default/bad_link.html' ($GT::Tar::error)";
return;
}
if ($CFG->{'build_default_tpl'} ne 'default') {
$file->name ("$CFG->{admin_root_path}/templates/$CFG->{'build_default_tpl'}/bad_link.html");
unless ($file->write) {
$Plugins::Bad_Link::error = "Unable to extract file: '$CFG->{admin_root_path}/templates/$CFG->{'build_default_tpl'}/bad_link.html' ($GT::Tar::error)";
return;
}
}
# Set permissions
chmod (0777, $file->name);
$mgr->install_menu ( 'Bad_Link',
[
['Help', 'admin.cgi?do=plugin&plugin=Bad_Link&func=help'],
['View Reports', 'admin.cgi?do=plugin&plugin=Bad_Link&func=view'],
['Edit Options', 'admin.cgi?do=page&page=plugin_manager.html&plugin_man_do=edit_installed&plugin_name=Bad_Link']
]
);
$mgr->install_options ( 'Bad_Link',
[
['table_name', $table_name, 'This is the name of the table used to store the bad links.']
# ['count_recs', '1', 'On to keep track of recc counts, off to ignore'],
# ['script_name', 'Bad_Link.cgi', 'If you\'ve changed thename of the scipt, enter it here.'],
# ['site_name', 'Your Site Name', 'Name of your site to show visitors.'],
# ['site_url', 'http://your_site.name', 'URL of your site to link to the Site Name above.']
]
);
if ($error) {
$Plugins::Bad_Link::error = $error;
return;
}
if ($message) {
return "The plugin has been installed, but there were the following warnings:
$message";
}
return "The plugin has been successfully installed!";
}
sub uninstall {
# -----------------------------------------------------------------------------
# This function removes the plugin. Its first argument is also a plugin
# manager which you can use to register hooks, install files, add menu options,
# etc. You should return an HTML formatted string that will be displayed to the
# user.
#
# If there is an error, return undef, and set the error message in
# $Plugins::Bad_Link::error
#
my $mgr = shift;
return "The plugin has been successfully removed!";
}
1;
Bad_Link.pm 0000644 0001773 0000373 00000007400 10130126354 013040 0 ustar posters posters # ==================================================================
# Plugins::Bad_Link - Auto Generated Program Module
#
# Plugins::Bad_Link
# Author : UltraNerds.com
# Version : 2.2.0
# Updated : Sun Oct 3 18:52:44 2004
#
# Report a bad link version '2.1.1a'
# Links SQL code copyright Gossamer Threads
# http://www.gossamer-threads.com
# Modifications and code segments copyright PUGDOG Enterprises, Inc.
# http://www.pugdog.com
# Updates for Links SQL 2.1.1 Compatiblity by Andy
# http://www.ace-installer.com
# ==================================================================
#
package Plugins::Bad_Link;
# ==================================================================
# Load required modules.
# ---------------------------------------------------
use strict;
use GT::Base;
use GT::Plugins qw/STOP CONTINUE/;
use Links qw/$CFG $IN $DB $USER/;
use lib '/path/to/links/admin'; ## you need to set this to your own local path!
use Links::SiteHTML; ## from old version
use Links::Authenticate; ## from old version
use Links::Plugins; ## from old version
use vars qw/$BAD_LINK_CFG/;
# Inherit from base class for debug and error methods
@Plugins::Bad_Link::ISA = qw(GT::Base);
# Your code begins here! Good Luck!
sub handle {
# Define the variables
# ---------------------------------------------------
my ($id, $db_links, $rec, $confirm);
# Get the Links ID number from the input.
$id = $IN->param('ID');
$confirm = $IN->param('confirm');
## check to see if an ID was submitted and that it was numeric
if (!(defined $id) or !($id =~ /^\d+$/)) {
print $IN->header();
print Links::SiteHTML::display('error', {error => "Invalid id: $id"});
return;
}
## Check to see if the ID/Link record exists
$db_links = $DB->table('Links'); ## first grab a new db handle
$rec = $db_links->get ($id); ## see if the ID record exists
if (! $rec) { ## handle errors
print $IN->header();
print Links::SiteHTML::display ('error', { error => Links::language ('JUMP_INVALIDID', $id) });
return;
}
print "The ID was found, the rec is ", %$rec, "
";
if (!($confirm)) {
$rec->{'Status'} = '';
print $IN->header();
print Links::SiteHTML::display ('bad_link', $rec ); return;
}
## Only waste the CPU after we've got a good link in the Links database.
##
## Need to put the configuration variables into the $CFG hash, or similar, and then
## they are globally available, and can be assigned/passed in a hash between routines.
## Works with persistence -- mod_perl speedyCGI, etc
$BAD_LINK_CFG = Links::Plugins::get_plugin_user_cfg ('Bad_Link');
my $bad_links_table = $BAD_LINK_CFG->{'table_name'};
# now, see if the record exists in the Bad_Links database
my $db_bad_links = $DB->table($bad_links_table);
my $rec2 = $db_bad_links->get ($id);
my $dynamic;
if ($db_bad_links->hits) {
$rec->{'Status'} = qq|
Thank you for taking the time to report the link $rec->{'Title'}
\n It's already been recorded, and and it's status is: $rec2->{'Status'} |; print $IN->header(); print Links::SiteHTML::display ('bad_link', $rec ); return; } else { $rec->{'Status'} = qq| Thank you for taking the time to report the link $rec->{'Title'}
\n It's been recorded, and will be checked ASAP |; $rec->{'Title'} =~ s/'/\\'/g; $rec->{'Title'} =~ s/"/\\"/g; $db_bad_links->add ( { LinkID => $id, URL => $rec->{'URL'}, Title => $rec->{'Title'}, IP => $ENV{'REMOTE_ADDR'} } ); print $IN->header(); print Links::SiteHTML::display ('bad_link', $rec ); return; } } ## end of main bad_link.html 0000644 0001773 0000373 00000004500 10130132512 013457 0 ustar posters posters
<%header_font%>BAD LINK REPORTED!<%/header_font%> | |
<%Status%> |
<%body_font%>Thank you for taking the time to report the following link as bad: | |||||||
|