#!/usr/bin/perl -w
# Copyright 2001-2006 Six Apart. This code cannot be redistributed without
# permission from www.sixapart.com. For more information, consult your
# Movable Type license.
#
# $Id$
use strict;
sub BEGIN {
my $dir;
require File::Spec;
if (!($dir = $ENV{MT_HOME})) {
if ($0 =~ m!(.*[/\\])!) {
$dir = $1;
} else {
$dir = './';
}
$ENV{MT_HOME} = $dir;
}
unshift @INC, File::Spec->catdir($dir, 'lib');
unshift @INC, File::Spec->catdir($dir, 'extlib');
}
local $| = 1;
my $mt;
my $lang = '__BUILD_LANGUAGE__';
eval {
require MT;
$mt = MT->new();
my $cfg = $mt->config;
$cfg->PublishCharset('utf-8');
$cfg->DefaultLanguage($lang);
};
use MT::L10N;
my $LH = $mt ? $mt->language_handle : MT::L10N->get_handle($lang);
sub trans_templ {
my($text) = @_;
return $mt->translate_templatized($text) if $mt;
$text =~ s!(]+?>|[^\3]+?)+?\3))+?\s*/?>)!
my($msg, %args) = ($1);
#print $msg;
while ($msg =~ /\b(\w+)\s*=\s*(["'])((?:<[^>]+?>|[^\2])*?)\2/g) { #"
$args{$1} = $3;
}
$args{params} = '' unless defined $args{params};
my @p = map MT::Util::decode_html($_),
split /\s*%%\s*/, $args{params};
@p = ('') unless @p;
my $translation = translate($args{phrase}, @p);
$translation =~ s/([\\'])/\\$1/sg if $args{escape};
$translation;
!ge;
$text;
}
sub translate {
return $mt->translate(@_) if $mt;
$LH->maketext(@_);
}
print "Content-Type: text/html; charset=utf-8\n\n";
print trans_templ(<
[mt-check.cgi]
[mt-check.cgi]
HTML
my $is_good = 1;
my @REQ = (
[ 'CGI', 0, 1, translate('CGI is required for all Movable Type application functionality.') ],
[ 'HTML::Template', 2, 1, translate('HTML::Template is required for all Movable Type application functionality.') ],
[ 'Image::Size', 0, 1, translate('Image::Size is required for file uploads (to determine the size of uploaded images in many different formats).') ],
[ 'File::Spec', 0.8, 1, translate('File::Spec is required for path manipulation across operating systems.') ],
[ 'CGI::Cookie', 0, 1, translate('CGI::Cookie is required for cookie authentication.') ],
);
my @DATA = (
[ 'DB_File', 0, 0, translate('DB_File is required if you want to use the Berkeley DB/DB_File backend.') ],
[ 'DBI', 1.21, 0, translate('DBI is required if you want to use any of the SQL database drivers.') ],
[ 'DBD::mysql', 0, 0, translate('DBI and DBD::mysql are required if you want to use the MySQL database backend.') ],
[ 'DBD::Pg', 1.32, 0, translate('DBI and DBD::Pg are required if you want to use the PostgreSQL database backend.') ],
[ 'DBD::SQLite', 0, 0, translate('DBI and DBD::SQLite are required if you want to use the SQLite database backend.') ],
[ 'DBD::SQLite2', 0, 0, translate('DBI and DBD::SQLite2 are required if you want to use the SQLite 2.x database backend.') ],
);
my @OPT = (
[ 'HTML::Entities', 0, 0, translate('HTML::Entities is needed to encode some characters, but this feature can be turned off using the NoHTMLEntities option in mt.cfg.') ],
[ 'LWP::UserAgent', 0, 0, translate('LWP::UserAgent is optional; It is needed if you wish to use the TrackBack system, the weblogs.com ping, or the MT Recently Updated ping.') ],
[ 'SOAP::Lite', 0.50, 0, translate('SOAP::Lite is optional; It is needed if you wish to use the MT XML-RPC server implementation.') ],
[ 'File::Temp', 0, 0, translate('File::Temp is optional; It is needed if you would like to be able to overwrite existing files when you upload.') ],
[ 'Image::Magick', 0, 0, translate('Image::Magick is optional; It is needed if you would like to be able to create thumbnails of uploaded images.') ],
[ 'Storable', 0, 0, translate('Storable is optional; it is required by certain MT plugins available from third parties.')],
[ 'Crypt::DSA', 0, 0, translate('Crypt::DSA is optional; if it is installed, comment registration sign-ins will be accelerated.')],
[ 'MIME::Base64', 0, 0, translate('MIME::Base64 is required in order to enable comment registration.')],
[ 'XML::Atom', 0, 0, translate('XML::Atom is required in order to use the Atom API.')],
);
use Cwd;
my $cwd = '';
{
my($bad);
local $SIG{__WARN__} = sub { $bad++ };
eval { $cwd = Cwd::getcwd() };
if ($bad || $@) {
eval { $cwd = Cwd::cwd() };
if ($@ && $@ !~ /Insecure \$ENV{PATH}/) {
die $@;
}
}
}
my $ver = $^V ? join('.', unpack 'C*', $^V) : $];
my $perl_ver_check = '';
if ($] < 5.006001) { # our minimal requirement for support
$perl_ver_check = <
EOT
}
my $server = $ENV{SERVER_SOFTWARE};
my $inc_path = join "
\n", @INC;
print trans_templ(<:
$perl_ver_check
-
$cwd
-
$ENV{MT_HOME}
- $^O
-
$ver
-
$inc_path
INFO
if ($server) {
print trans_templ(< $server
INFO
}
## Try to create a new file in the current working directory. This
## isn't a perfect test for running under cgiwrap/suexec, but it
## is a pretty good test.
my $TMP = "test$$.tmp";
local *FH;
if (open(FH, ">$TMP")) {
print trans_templ(" \n");
unlink($TMP);
}
print "\n\n
\n";
exit if $ENV{QUERY_STRING} && $ENV{QUERY_STRING} eq 'sys-check';
for my $list (\@REQ, \@DATA, \@OPT) {
my $data = ($list == \@DATA);
my $req = ($list == \@REQ);
my $type;
if ($data) {
$type = translate("Data Storage");
} elsif ($req) {
$type = translate("Required");
} else {
$type = translate("Optional");
}
print trans_templ(qq{
\n\t\n});
if (!$req && !$data) {
print trans_templ(<
MSG
}
if ($data) {
print trans_templ(<
MSG
}
my $got_one_data = 0;
my $dbi_is_okay = 0;
for my $ref (@$list) {
my($mod, $ver, $req, $desc) = @$ref;
print "\n" if $mod =~ m/^DBD::/;
print " $mod" .
($ver ? " (version >= $ver)" : "") . "
";
eval("use $mod" . ($ver ? " $ver;" : ";"));
if ($@) {
$is_good = 0 if $req;
my $msg = $ver ?
trans_templ(qq{ }) :
trans_templ(qq{ });
$msg .= $desc .
trans_templ(qq{
\n\n});
print $msg . "\n\n";
} else {
if ($data) {
$dbi_is_okay = 1 if $mod eq 'DBI';
if ($mod eq 'DB_File') {
$got_one_data = 1;
} elsif ($mod ne 'DBI') {
if ($mod eq 'DBD::mysql') {
if ($DBD::mysql::VERSION == 3.0000) {
print trans_templ(qq{
});
}
}
if (!$dbi_is_okay) {
print trans_templ(qq{
});
} else {
$got_one_data = 1;
}
}
}
print trans_templ(qq{
\n\n});
}
print "
\n" if $mod =~ m/^DBD::/;
}
$is_good &= $got_one_data if $data;
print "\n\t \n\n";
}
if ($is_good) {
print trans_templ(<
HTML
}
print "\n\n\n";