#!/usr/bin/perl
#
# Copyright (C) 2005 Groupee, Inc.
#
#
# Most of this code stolen straight from the original ultimatebb.cgi
# Thanks to Ian Spence
# Replacement ultimatebb.cgi script.
# $URL needs to be set to your ubb.threads installation.
$URL = "http://www.raisinggodlytomatoes.com/ubbthreads";
# site_id only needs to be changed if you've imported multiple forums. The importer
# will tell you what your site id needs to be changed to
$site_id = 1;
# What type of redirect shall we send?
# 0 - Don't send a 301/302 header, my webserver does this. (Enable this if 301/302 results in an ISE or blank page)
# 301 - Permanent
# 302 - Temporary
$redirect = 301;
# Search engine friendly redirects? Change to 0 to disable
$search_friendly = 0;
# You shouldn't need to edit anything below this line
$var_start = "?";
$var_sep = "&";
$var_eq = "=";
if ($search_friendly == 1) {
$var_start = "/";
$var_sep = "/";
$var_eq = "/";
}
# added by shane:
# print("200 blah\n\n");
# print("test \$ENV\{'QUERY_STRING'\}: $ENV{'QUERY_STRING'}\n");
# print("ubb\=$in{'ubb'}\n");
# print("f\=$in{'f'}\n");
# ------
# Get our arguments
%in = map{
my @z = param($_);
( scalar(@z) > 1 ?
( $_ => join(",", @z) ) :
( $_ => $z[0] )
)
} param();
# added by shane:
$ENV{'QUERY_STRING'} =~ s/&/\;/g;
# ------
# added by shane:
if (length ($ENV{'QUERY_STRING'}) > 0){
$buffer = $ENV{'QUERY_STRING'};
@pairs = split(';', $buffer);
foreach $pair (@pairs){
($name, $value) = split(/=/, $pair);
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$in{$name} = $value;
}
}
# --------
# See if we have any args in the path
my $pi = $ENV{PATH_INFO};
$pi = "" if($ENV{PATH_INFO} eq $ENV{SCRIPT_NAME});
if(!$pi && ($ENV{QUERY_STRING} =~ m/^\//)) {
$pi = $ENV{QUERY_STRING};
} # end if
# added by shane:
# print("test pi: $pi\n");
# print("test in: $in\n");
# print("test ubb: $in{'ubb'}\n");
# print("test f: $in{'f'}\n");
# print("test t: $in{'t'}\n");
# print("test p: $in{'p'}\n");
# exit(0);
# ----
if($pi ne "") {
my @args = split(/\//, $pi);
shift @args; # first arg is always blank
$args[-1] =~ s/\.html$// if @args;
if(($args[0] eq "ubb") && (scalar(@args) % 2 == 0)) {
# proper pairing
%in = (@args, %in);
} elsif(($args[0] eq "ubb") && (scalar(@args) % 2 == 1)) {
# Sigh, we're missing an argument...
pop @args; # so yank it
%in = (@args, %in);
} elsif($args[0] eq "topic") {
%in = (
ubb => "get_topic",
f => $args[1],
t => &Do6Digit($args[2]),
p => $args[3],
%in,
);
} elsif($args[0] eq "forum") {
%in = (
ubb => "forum",
f => $args[1],
hardset => $args[2],
start_point => $args[3],
%in,
);
} elsif($args[0] eq "profile") {
%in = (
ubb => "get_profile",
u => &Do8Digit($args[1]),
%in,
);
} # end if
} # end if
# I actually have to look up how to do a foreach in perl.
# I've possibly been away from it too long
$query = "";
foreach my $key (keys %in) {
$query .= qq~$key=$in{$key}&~;
}
# If ubb = get_topic we'll redirect to showflat
if ($in{'ubb'} eq "get_topic") {
if ($redirect eq "301") {
print(qq~Status: HTTP/1.1 301 Moved Permanently\n~ );
} elsif ($redirect eq "302") {
print(qq~Status: HTTP/1.1 302 Moved Temporarily\n~ );
}
if (!$in{'f'}) {$in{'f'} = 0; }
if (!$in{'t'}) {$in{'t'} = 0; }
if (!$in{'p'}) {$in{'p'} = 0; }
if ($search_friendly) {
print(qq~Location: $URL/ubbthreads.php/ubb/showflat/Forum/$in{'f'}/topic/$in{'t'}/Number/$in{'p'}/site_id/$site_id#import\n\n~);
} else {
print(qq~Location: $URL/ubbthreads.php?ubb=showflat&Forum=$in{'f'}&topic=$in{'t'}&Number=$in{'p'}&site_id=$site_id#import\n\n~);
}
exit(0);
} else {
if ($redirect eq "301") {
print(qq~Status: HTTP/1.1 301 Moved Permanently\n~ );
} elsif ($redirect eq "302") {
print(qq~Status: HTTP/1.1 302 Moved Temporarily\n~ );
}
if ($search_friendly) {
print(qq~Location: $URL/ubbthreads.php/ubb/cfrm\n\n~ );
} else {
print(qq~Location: $URL/ubbthreads.php?ubb=cfrm\n\n~ );
}
exit(0);
}
sub param {
my($name,$value,@other);
# For compatibility between old calling style and use_named_parameters() style,
# we have to special case for a single parameter present.
if (@p > 1) {
($name,$value,@other) = $self->rearrange([NAME,[DEFAULT,VALUE,VALUES]],@p);
my(@values);
if (substr($p[0],0,1) eq '-' || $self->use_named_parameters) {
@values = defined($value) ? (ref($value) && ref($value) eq 'ARRAY' ? @{$value} : $value) : ();
} else {
foreach ($value,@other) {
push(@values,$_) if defined($_);
}
}
# If values is provided, then we set it.
if (@values) {
$self->add_parameter($name);
$self->{$name}=[@values];
}
} else {
$name = $p[0];
}
return unless defined($name) && $self->{$name};
return wantarray ? @{$self->{$name}} : $self->{$name}->[0];
}
sub Do8Digit {
return (sprintf("%.8d", $_[0]));
}
sub Do6Digit {
return (sprintf("%.6d", $_[0]));
}