#!/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]));
}