saint/discourse-legacysite-perl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

First pass at adding key files

Browse Source
This commit is contained in:
dsainty
2024-06-17 21:49:12 +10:00
commit aa25e9347f
1274 changed files with 392549 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

499
site/slowtwitch.com/cgi-bin/articles/admin/Links/Browser/Controller.pm Normal file
View File

@@ -0,0 +1,499 @@
# ==================================================================
# 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: Controller.pm,v 1.9 2009/07/09 23:13:41 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::Browser::Controller;
# ==================================================================
use strict;
use vars qw/@ISA $AUTOLOAD $ATTRIBS/;
use GT::Base;
use Links qw/$CFG $IN $DB/;
use Links::Browser;
@ISA = qw/GT::Base/;
$ATTRIBS = {
user_base_node => [],
load_tree => 0,
perms => {},
admin => 0,
user => {},
admin_templates => 0
};
sub can_run {
# -------------------------------------------------------------------
# Determines whether or not the user can run the requested function.
#
my $self = shift;
my $action = $IN->param ("action") || return "main_panel_init";
if (exists $Links::Browser::COMPILE{$action}) {
if ($self->{admin}) {
return $action;
}
if ($self->$action()) { return $action }
else { return }
}
else { return }
return $action;
}
# Everyone can load the browser.
sub main_panel_init { return 1 }
sub tree_panel_init { return 1 }
sub info_panel_init { return 1 }
sub code_panel_init { return 1 }
sub code_panel_reload_empty { return 1 }
sub code_panel_reload_full { return 1 }
sub category_click {
# -------------------------------------------------------------------
# Determine whether the user can view a category.
#
my $self = shift;
return $self->is_in_subtree ($IN->param ('category_id'));
}
sub code_panel_category_expand {
# -------------------------------------------------------------------
# Expand a section of the tree.
#
my $self = shift;
return $self->is_in_subtree ($IN->param ('category_id'));
}
sub category_add_form {
# -------------------------------------------------------------------
# Display add form.
#
my $self = shift;
my $base = $self->is_in_subtree ($IN->param ('category_id')) or return;
return ($self->{perms}->{$base}->{CanAddCat} eq 'Yes') ? 1 : 0;
}
sub category_add {
# -------------------------------------------------------------------
# Determines whether you can actually add a category.
#
my $self = shift;
my $base = $self->is_in_subtree ($IN->param ('FatherID')) or return;
return ($self->{perms}->{$base}->{CanAddCat} eq 'Yes') ? 1 : 0;
}
sub category_del_form {
# -------------------------------------------------------------------
# Display category delete form.
#
my $self = shift;
my $base = $self->is_in_subtree ($IN->param ('category_id')) or return;
return ($self->{perms}->{$base}->{CanDelCat} eq 'Yes') ? 1 : 0;
}
sub category_del { return shift->category_del_form (@_); }
sub category_modify_form {
# -------------------------------------------------------------------
# Display category modify form.
#
my $self = shift;
my $base = $self->is_in_subtree ($IN->param ('category_id')) or return;
return ($self->{perms}->{$base}->{CanModCat} eq 'Yes') ? 1 : 0;
}
sub category_modify {
# -------------------------------------------------------------------
# Determines whether you can actually modify the given category.
#
my $self = shift;
my $base = $self->is_in_subtree ($IN->param ('ID')) or return;
return ($self->{perms}->{$base}->{CanModCat} eq 'Yes') ? 1 : 0;
}
sub category_move_form {
# -------------------------------------------------------------------
# Display category move form.
#
my $self = shift;
my $base = $self->is_in_subtree ($IN->param ('category_id')) or return;
return ($self->{perms}->{$base}->{CanMoveCat} eq 'Yes') ? 1 : 0;
}
sub category_move {
# -------------------------------------------------------------------
# Display category move form.
#
my $self = shift;
my $base1 = $self->is_in_subtree ($IN->param ('category_from')) or return;
my $base2 = $self->is_in_subtree ($IN->param ('category_to')) or return;
$self->{perms}->{$base1}->{CanMoveCat} eq 'Yes' or return;
$self->{perms}->{$base2}->{CanMoveCat} eq 'Yes' or return;
return 1;
}
sub category_editors_form {
# -------------------------------------------------------------------
# Display category editors form and process edits.
#
my $self = shift;
return if (defined $self->{perms}->{CanAddEdit} and $self->{perms}->{CanAddEdit} eq 'No');
my $base = $self->is_in_subtree ($IN->param ('category_id')) or return;
$self->{perms}->{$base}->{CanAddEdit} eq 'Yes' or return;
foreach my $key ($IN->param('to_delete')) {
my ($name, $id) = split /\|/, $key;
$base = $self->is_in_subtree ($id) or return;
$self->{perms}->{$base}->{CanAddEdit} eq 'Yes' or return;
}
return 1;
}
sub category_related_form {
# -------------------------------------------------------------------
# Display related categories form and process relations.
#
my $self = shift;
return if (defined $self->{perms}->{CanAddRel} and $self->{perms}->{CanAddRel} eq 'No');
my $base = $self->is_in_subtree ($IN->param ('category_id')) or return;
$self->{perms}->{$base}->{CanAddRel} eq 'Yes' or return;
foreach my $id ($IN->param('to_delete')) {
$base = $self->is_in_subtree ($id) or return;
$self->{perms}->{$base}->{CanAddRel} eq 'Yes' or return;
}
return 1;
}
sub link_user_list {
# -------------------------------------------------------------------
# Display list of links this user owns.
#
my $self = shift;
my $base = $self->is_in_subtree ($IN->param('category_id')) or return;
return 1;
}
sub link_add_form {
# -------------------------------------------------------------------
# Display add link form.
my $self = shift;
my $base = $self->is_in_subtree ($IN->param ('category_id')) or return;
return ($self->{perms}->{$base}->{CanAddLink} eq 'Yes') ? 1 : 0;
}
sub link_add {
# -------------------------------------------------------------------
# Display add link form.
my $self = shift;
my $base = $self->is_in_subtree ($IN->param ('CatLinks.CategoryID')) or return;
return ($self->{perms}->{$base}->{CanAddLink} eq 'Yes') ? 1 : 0;
}
sub link_modify_form {
# -------------------------------------------------------------------
# Display modify link form.
#
my $self = shift;
my $catlinks = $DB->table('CatLinks');
my $q = $catlinks->select({ LinkID => $IN->param("link_id") || $IN->param('ID') });
my $allowed = 0;
while (my $h = $q->fetchrow_hashref) {
my $base = $self->is_in_subtree ($h->{CategoryID}) or next;
if ($self->{perms}->{$base}->{CanModLink} eq 'Yes') {
$allowed = 1;
last;
}
}
return $allowed;
}
sub link_modify {
# -------------------------------------------------------------------
# Display modify link form.
#
my $self = shift;
$self->link_modify_form(@_);
}
sub link_del_form {
# -------------------------------------------------------------------
# Display delete link form.
#
my $self = shift;
return if (defined $self->{perms}->{CanDelLink} and $self->{perms}->{CanDelLink} eq 'No');
my $catlinks = $DB->table (qw /CatLinks/);
my $q = $catlinks->select ( { LinkID => scalar $IN->param ("link_id") } );
my $allowed = 0;
while (my $h = $q->fetchrow_hashref) {
my $base = $self->is_in_subtree ($h->{CategoryID}) or next;
if ($self->{perms}->{$base}->{CanDelLink} eq 'Yes') {
$allowed = 1;
last;
}
}
return $allowed;
}
sub link_del { shift->link_del_form (@_); }
sub link_move_form {
# -------------------------------------------------------------------
# Display form to move link.
#
my $self = shift;
my $base = $self->is_in_subtree ($IN->param ('category_id')) or return;
return ($self->{perms}->{$base}->{CanMoveLink} eq 'Yes') ? 1 : 0;
}
sub link_move {
# -------------------------------------------------------------------
# Checks whether the link can be moved into the requested category.
#
my $self = shift;
my $old_category_id = $IN->param ("old_category_id");
my $new_category_id = $IN->param ("new_category_id");
my $base1 = $self->is_in_subtree ($old_category_id) or return;
my $base2 = $self->is_in_subtree ($new_category_id) or return;
$self->{perms}->{$base1}->{CanMoveLink} eq 'Yes' or return;
$self->{perms}->{$base2}->{CanMoveLink} eq 'Yes' or return;
return 1;
}
sub link_copy_form {
# -------------------------------------------------------------------
# Display form to copy a link.
#
my $self = shift;
my $base = $self->is_in_subtree ($IN->param ('category_id')) or return;
return ($self->{perms}->{$base}->{CanCopyLink} eq 'Yes') ? 1 : 0;
}
sub link_copy {
# -------------------------------------------------------------------
# Checks whether a link can be moved into requested category.
#
my $self = shift;
my $old_category_id = $IN->param ("old_category_id");
my $new_category_id = $IN->param ("new_category_id");
my $base1 = $self->is_in_subtree ($old_category_id) or return;
my $base2 = $self->is_in_subtree ($new_category_id) or return;
$self->{perms}->{$base1}->{CanCopyLink} eq 'Yes' or return;
$self->{perms}->{$base2}->{CanCopyLink} eq 'Yes' or return;
return 1;
}
sub link_validate_list {
# -------------------------------------------------------------------
# Checks whether a user can display links awaiting validation.
#
my $self = shift;
my $base = $self->is_in_subtree ($IN->param ('category_id')) or return;
return ($self->{perms}->{$base}->{CanValLink} eq 'Yes') ? 1 : 0;
}
sub link_validate_detailed {
# -------------------------------------------------------------------
# Checks whether a user can display links awaiting validation.
#
my $self = shift;
my $base = $self->is_in_subtree ($IN->param ('category_id')) or return;
# Let's parse out the form, and group our links together.
my $args = $IN->get_hash();
my $catlinks_db = $DB->table( 'CatLinks' );
my ( @denied, @allowed );
while (my ($key, $param) = each %$args) {
if ($key =~ /^validate-(\d+)/) {
my $id = $1;
my $q = $catlinks_db->select ( { LinkID => $id } );
my $base;
while (my $h = $q->fetchrow_hashref ) {
if ( $base = $self->is_in_subtree ($h->{CategoryID})
and $self->{perms}->{$base}->{CanValLink} eq 'Yes' ) {
push @allowed, $id;
next;
}
push @denied, $id;
}
}
}
# Remove action verbs for any listings the user is not allowed to validate
for my $id ( @denied ) {
$IN->param( "validate-$id", undef );
}
return ($self->{perms}->{$base}->{CanValLink} eq 'Yes') ? 1 : 0;
}
sub link_validate_changes_list {
# -------------------------------------------------------------------
# Checks whether a user can display links awaiting validation.
#
my $self = shift;
my $base = $self->is_in_subtree ($IN->param ('category_id')) or return;
return ($self->{perms}->{$base}->{CanValLink} eq 'Yes') ? 1 : 0;
}
sub link_validate_form {
# -------------------------------------------------------------------
# Checks whether a user can display links awaiting validation.
#
my $self = shift;
my $base = $self->is_in_subtree ($IN->param ('category_id')) or return;
return ($self->{perms}->{$base}->{CanValLink} eq 'Yes') ? 1 : 0;
}
sub link_validate {
# -------------------------------------------------------------------
# Checks whether user can actually validate link.
#
my $self = shift;
my $base = $self->is_in_subtree ($IN->param ('category_id')) or return;
return ($self->{perms}->{$base}->{CanValLink} eq 'Yes') ? 1 : 0;
}
sub review_list {
# -------------------------------------------------------------------
# Checks whether a user can display reviews awaiting validation.
#
my $self = shift;
my $base = $self->is_in_subtree ($IN->param ('category_id')) or return;
return ($self->{perms}->{$base}->{CanModReview} eq 'Yes') ? 1 : 0;
}
sub review_del_form {
# -------------------------------------------------------------------
# Checks whether a user can delete reviews.
#
my $self = shift;
my $base = $self->is_in_subtree ($IN->param ('category_id')) or return;
return ($self->{perms}->{$base}->{CanModReview} eq 'Yes') ? 1 : 0;
}
sub review_del {
# -------------------------------------------------------------------
# Checks whether a user can delete reviews.
#
my $self = shift;
my $base = $self->is_in_subtree ($IN->param ('category_id')) or return;
return ($self->{perms}->{$base}->{CanModReview} eq 'Yes') ? 1 : 0;
}
sub review_modify_form {
# -------------------------------------------------------------------
# Checks whether a user can display the review modify form.
#
my $self = shift;
my $base = $self->is_in_subtree ($IN->param ('category_id')) or return;
return ($self->{perms}->{$base}->{CanModReview} eq 'Yes') ? 1 : 0;
}
sub review_modify {
# -------------------------------------------------------------------
# Checks whether user can actually validate reviews.
#
my $self = shift;
my $base = $self->is_in_subtree ($IN->param ('category_id')) or return;
return ($self->{perms}->{$base}->{CanModReview} eq 'Yes') ? 1 : 0;
}
sub link_search_form {
# -------------------------------------------------------------------
# Display search link form.
my $self = shift;
if (!$IN->param('category_id')) {
my @check_ids;
if (ref $self->{ctrl}->user_base_node) {
@check_ids = @{$self->{ctrl}->user_base_node};
}
else {
$check_ids[0] = $self->{ctrl}->user_base_node;
}
$IN->param('category_id',$check_ids[0]);
}
my $base = $self->is_in_subtree ($IN->param ('category_id')) or return;
return 1;
}
sub link_search_results {
# -------------------------------------------------------------------
# Display search link form.
my $self = shift;
if ($IN->param('in_category')) {
return if (!$self->is_in_subtree ($IN->param ('in_category')));
}
if (!$IN->param('category_id')) {
my @check_ids;
if (ref $self->user_base_node) {
@check_ids = @{$self->user_base_node};
}
else {
$check_ids[0] = $self->user_base_node;
}
$IN->param('category_id',$check_ids[0]);
}
my $base = $self->is_in_subtree ($IN->param ('category_id')) or return;
return 1;
}
sub is_in_subtree {
# -------------------------------------------------------------------
# Returns the category ID of the base node this user is in.
#
my $self = shift;
my $base_r = $self->user_base_node();
@$base_r || return 1; # Root can do anything, no base specified.
my $node = shift or return; # No node specified!
my $category = $DB->table (qw /Category/);
my $info_node = $category->get ( { ID => $node }, 'HASH', ['ID','Full_Name']);
defined $info_node or return; # Invalid node requested.
# Get closest permissions first.
$category->select_options ("ORDER BY Full_Name DESC");
my $sth = $category->select ( ['ID', 'Full_Name'], { ID => $base_r });
while (my ($id, $name) = $sth->fetchrow_array) {
($info_node->{Full_Name} =~ m,^\Q$name\E(?:/|$),) and return $id;
}
return;
}
sub perms {
# -------------------------------------------------------------------
# Returns a list of permissions the user has for a requested category.
#
my ($self, $category_id) = @_;
if ($self->{admin}) {
return { CanAddCat => 'Yes', CanDelCat => 'Yes', CanModCat => 'Yes', CanMoveCat => 'Yes',
CanAddLink => 'Yes', CanDelLink => 'Yes', CanModLink => 'Yes', CanMoveLink => 'Yes', CanCopyLink => 'Yes',
CanValLink => 'Yes', CanModReview => 'Yes',
CanAddRel => 'Yes', CanAddEdit => 'Yes' };
}
my $base = $self->is_in_subtree($category_id) or return {};
if (exists $self->{perms}->{$base}) {
return $self->{perms}->{$base};
}
return {};
}
##
# $obj->user_base_node;
# ---------------------
# Returns an array ref of categories the user can edit.
##
sub user_base_node { return shift->{user_base_node} || [] }
1;

212
site/slowtwitch.com/cgi-bin/articles/admin/Links/Browser/JFunction.pm Normal file
View File

@@ -0,0 +1,212 @@
# ==================================================================
# 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: JFunction.pm,v 1.16 2005/03/22 01:42:22 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::Browser::JFunction;
# ==================================================================
use strict;
use Links qw/$CFG $IN $DB/;
##
# Path to image urls.
##
sub node_expand_button_fake { return $CFG->{build_static_url} . "/browser/expandfake.gif"; }
sub node_expand_button_plus { return $CFG->{build_static_url} . "/browser/expandplus.gif"; }
sub node_expand_button_less { return $CFG->{build_static_url} . "/browser/expandless.gif"; }
sub node_unselected_button { return $CFG->{build_static_url} . "/browser/unselected.gif"; }
##
# $obj->tree_loadnode;
# --------------------
# This function must return the URL that the Javascript
# must point the user to when an unloaded node has been expanded.
##
sub tree_loadnode
{
my $cgix = new GT::CGI ($IN);
$cgix->param ("action", "code_panel_category_expand");
return $cgix->url;
}
##
# $obj->tree_selectnode;
# ----------------------
# This function must return the URL that the Javascript
# must point the user to when a node is selected, i.e
# showing a certain category.
##
sub tree_selectnode
{
my $cgix = new GT::CGI ($IN);
$cgix->param ("action", "category_click");
return $cgix->url;
}
##
# $obj->tree_panel_url;
# ---------------------
# This function returns the URL that should be used
# in order to display ...
##
sub tree_panel_url
{
my $cgix = new GT::CGI ($IN);
$cgix->param ("action", "tree_panel_init");
return $cgix->url;
}
##
# $obj->info_panel_url;
# ---------------------
# This function returns the URL that should be used
# in order to display ...
##
sub info_panel_url
{
my $cgix = new GT::CGI ($IN);
$cgix->param ("action", "info_panel_init");
return $cgix->url;
}
##
# $obj->code_panel_url;
# ---------------------
# This function returns the URL that should be used
# in order to display ...
##
sub code_panel_url
{
my $cgix = new GT::CGI ($IN);
$cgix->param ("action", "code_panel_init");
return $cgix->url;
}
##
# $obj->tree_reload_empty;
# ------------------------
# This method returns the URL that when called in the code
# panel empties the Javascript Tree.
##
sub tree_reload_empty
{
my $cgix = new GT::CGI ($IN);
$cgix->param ("action", "code_panel_reload_empty");
return $cgix->url;
}
##
# $obj->tree_reload_full;
# -----------------------
# This method returns the URL that when called in the code
# panel replaces the Javascript tree with a fully loaded
# tree (no need to database for requests).
##
sub tree_reload_full
{
my $cgix = new GT::CGI ($IN);
$cgix->param ("action", "code_panel_reload_full");
return $cgix->url;
}
##
# $obj->tree_refreshnode_url;
# ---------------------------
# This method should return the URL that has to be invoked
# when an user has updated a node and wants to refresh the
# node's contents.
##
sub tree_refreshnode_url
{
my $cgix = new GT::CGI ($IN);
$cgix->param ("action", "code_panel_init");
return $cgix->url;
}
##
# $obj->user_add_node;
# --------------------
# This method should return the URL that must be invoked
# by the code frame when an user has added a subcategory
# and that the javascript tree needs being refreshed.
##
sub user_add_node
{
my $cgix = new GT::CGI ($IN);
$cgix->param ("action", "code_panel_category_add");
return $cgix->url;
}
##
# $obj->tree_movenode;
# ---------------------
# This method should return the URL that must be invoked
# by the code frame when an user has added a subcategory
# and that the javascript tree needs being refreshed.
##
sub tree_movenode
{
my $cgix = new GT::CGI ($IN);
$cgix->param ("action", "category_move");
return $cgix->url;
}
##
# $obj->tree_movelink;
# --------------------
##
sub movelink
{
my $cgix = new GT::CGI ($IN);
$cgix->param ("action", "link_move");
return $cgix->url;
}
##
# $obj->tree_copylink;
# --------------------
##
sub copylink
{
my $cgix = new GT::CGI ($IN);
$cgix->param ("action", "link_copy");
return $cgix->url;
}
##
# $obj->category_related_url;
# ---------------------
# This function returns the URL that should be used
# in order to relate categories ...
##
sub category_related_url
{
my $cgix = new GT::CGI ($IN);
$cgix->param ("action", "category_related_form");
return $cgix->url;
}
1;