Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

executable file 101 lines (86 sloc) 2.968 kb
#!/usr/bin/perl -w
#
# This is the perl-based module handler. It is the counterpart of mythweb.php
#
#
# Load some required modules
use CGI qw/:standard/;
use DBI;
use Cwd 'abs_path';
use File::Basename;
# pwd is / when running under mod_rewrite, so we should chdir to the script
# directory for consistency
chdir dirname(abs_path($ENV{'SCRIPT_FILENAME'} or $0));
# Don't forget to include the current directory in the search path.
substr($ENV{'PATH'}, 0, 0) = '.:';
# Create a cgi object;
our $cgi = new CGI;
# Extract the requested path
our @Path;
$Path[0] = ($ENV{'PATH_INFO'} or url_param('PATH_INFO'));
$Path[0] =~ s#^/+##sg;
$Path[0] =~ s#\s+$##sg;
@Path = split('/', $Path[0]);
shift @Path if ($Path[0] eq 'pl');
# Figure out the root web directory
our $web_root = dirname($ENV{'SCRIPT_NAME'}).'/';
$web_root =~ s#//#/#g;
# Add a directory to the search path?
if ($ENV{'include_path'}) {
$ENV{'PATH'} .= ':'.$ENV{'include_path'};
}
# Work around a lighttpd bug: http://trac.lighttpd.net/trac/ticket/420
foreach my $key (keys %ENV) {
$ENV{lc($key)} = $ENV{$key} if ($key =~ m/DB_/);
}
# Connect to the database
END { $dbh->disconnect() if ($dbh); }
our $dbh = DBI->connect("dbi:mysql:database=$ENV{'db_name'}:host=$ENV{'db_server'}",
$ENV{'db_login'},
$ENV{'db_password'});
unless ($dbh) {
print header(),
"Cannot connect to database: $!\n\n";
exit;
}
# Set database connection to utf8
$dbh->prepare("SET NAMES utf8;")->execute();
# Make sure UNIX_TIMESTAMP AND FROM_UNIXTIME do the right things
$dbh->prepare("SET time_zone='+0:00';")->execute();
# Find the path to the modules directory
our $modules_dir = dirname(dirname(find_in_path('modules/tv/init.php')));
# Figure out what the user is trying to do
if ($Path[0]) {
if (-e "$modules_dir/$Path[0]") {
if (-e "$modules_dir/$Path[0]/handler.pl") {
require "modules/$Path[0]/handler.pl";
}
else {
print header(),
"Module '$Path[0]' doesn't have a perl handler.";
}
}
elsif ($Path[0] =~ /\w/) {
print header(),
"Unknown module: $Path[0]";
}
}
else {
print header(-location => $web_root);
print " \n";
}
# Exit nicely
exit;
################################################################################
# Find a file in the current include path
sub find_in_path {
my $file = shift;
# Split out each of the search paths
foreach my $path (@INC, split(/:/, $ENV{'PATH'})) {
# Formulate the absolute path
my $full_path = "$path/$file";
# Exists?
return $full_path if (-e $full_path);
}
return undef;
}
Jump to Line
Something went wrong with that request. Please try again.