fix slurping of command output and errors; correct incorrect references to file.version and config variables; extract the version from CVS/Entries now that we aren't checking out to standard output and therefore don't get version info on standard error; localize $/ so we won't mess things up globally; add info about required Perl modules to README; and fix formatting in Doctor.pm

git-svn-id: svn://10.0.0.236/trunk@156068 18797224-902f-48f8-a5cc-f745e15eee43
This commit is contained in:
myk%mozilla.org
2004-05-07 02:30:25 +00:00
parent dab4e743f6
commit 326f3c420f
6 changed files with 89 additions and 89 deletions

View File

@@ -13,26 +13,12 @@ use AppConfig qw(:expand :argcount);
# Create the global template object that processes templates and specify
# configuration parameters that apply to templates processed in this script.
our $template = Template->new(
{
our $template = Template->new({
# Colon-separated list of directories containing templates.
INCLUDE_PATH => "templates" ,
PRE_CHOMP => 1,
POST_CHOMP => 1,
FILTERS =>
{
linebreak => sub
{
my ($var) = @_;
$var =~ s/\\/\\\\/g;
$var =~ s/\n/\\n/g;
$var =~ s/\r/\\r/g;
return $var;
}
}
}
);
INCLUDE_PATH => "templates",
PRE_CHOMP => 1,
POST_CHOMP => 1
});
# Define the global variables and functions that will be passed to the UI
# template. Individual functions add their own values to this hash before
@@ -42,66 +28,64 @@ our $vars = {};
# Create an AppConfig object and populate it with parameters defined
# in the configuration file.
# Note: Look in the configuration file for descriptions of each parameter.
our $config = AppConfig->new(
{
our $config = AppConfig->new({
CASE => 1,
CREATE => 1 ,
GLOBAL => {
ARGCOUNT => ARGCOUNT_ONE ,
}
}
);
GLOBAL => { ARGCOUNT => ARGCOUNT_ONE }
});
$config->file("doctor.conf");
our %CONFIG = $config->varlist(".*");
$vars->{'config'} = \%CONFIG;
sub system_capture {
# Runs a command and captures its output and errors. This should be using
# in-memory files, but they require that we close STDOUT and STDERR
# before reopening them on the in-memory files, and closing and reopening
# STDERR causes CVS to choke with return value 256.
my ($command, @args) = @_;
my ($rv, $output, $errors);
# Back up the original STDOUT and STDERR so we can restore them later.
open(OLDOUT, ">&STDOUT") or die "Can't back up STDOUT to OLDOUT: $!";
open(OLDERR, ">&STDERR") or die "Can't back up STDERR to OLDERR: $!";
use vars qw( $OLDOUT $OLDERR ); # suppress "used only once" warnings
# Close and reopen STDOUT and STDERR to in-memory files, which are just
# scalars that take output and append it to their value.
# XXX Disabled in-memory files in favor of temp files until in-memory issues
# can be worked out.
#close STDOUT;
#close STDERR;
#open STDOUT, ">", \$output or die "Can't open STDOUT to output var: $!";
#open STDERR, ">", \$errors or die "Can't open STDERR to errors var: $!";
my $outtmpfile = tempfile();
my $errtmpfile = tempfile();
open(STDOUT, ">$outtmpfile") or die "Can't dupe STDOUT to output cache: $!";
open(STDERR, ">$errtmpfile") or die "Can't dupe STDERR to errors cache: $!";
# Run the command.
$rv = system($command, @args);
# Restore original STDOUT and STDERR.
close(STDOUT);
close(STDERR);
open(STDOUT, ">&OLDOUT") or die "Can't restore STDOUT from OLDOUT: $!";
open(STDERR, ">&OLDERR") or die "Can't restore STDERR from OLDERR: $!";
# Grab output and errors from the caches.
# XXX None of this would be necessary if in-memory files was working.
undef $/;
seek($outtmpfile, 0, 0);
seek($errtmpfile, 0, 0);
$output = <$outtmpfile>;
$errors = <$errtmpfile>;
return ($rv, $output, $errors);
# Runs a command and captures its output and errors. This should be using
# in-memory files, but they require that we close STDOUT and STDERR
# before reopening them on the in-memory files, and closing and reopening
# STDERR causes CVS to choke with return value 256.
my ($command, @args) = @_;
my ($rv, $output, $errors);
# Back up the original STDOUT and STDERR so we can restore them later.
open(OLDOUT, ">&STDOUT") or die "Can't back up STDOUT to OLDOUT: $!";
open(OLDERR, ">&STDERR") or die "Can't back up STDERR to OLDERR: $!";
use vars qw( $OLDOUT $OLDERR ); # suppress "used only once" warnings
# Close and reopen STDOUT and STDERR to in-memory files, which are just
# scalars that take output and append it to their value.
# XXX Disabled in-memory files in favor of temp files until in-memory issues
# can be worked out.
#close STDOUT;
#close STDERR;
#open STDOUT, ">", \$output or die "Can't open STDOUT to output var: $!";
#open STDERR, ">", \$errors or die "Can't open STDERR to errors var: $!";
my $outfile = tempfile();
my $errfile = tempfile();
open(STDOUT, ">&", $outfile) or die "Can't dupe STDOUT to output file: $!";
open(STDERR, ">&", $errfile) or die "Can't dupe STDERR to errors file: $!";
# Run the command.
$rv = system($command, @args);
# Grab output and errors from the temp files. In a block to localize $/.
# XXX None of this would be necessary if in-memory files was working.
{
local $/ = undef;
seek($outfile, 0, 0);
seek($errfile, 0, 0);
$output = <$outfile>;
$errors = <$errfile>;
}
# Restore original STDOUT and STDERR.
close(STDOUT);
close(STDERR);
open(STDOUT, ">&OLDOUT") or die "Can't restore STDOUT from OLDOUT: $!";
open(STDERR, ">&OLDERR") or die "Can't restore STDERR from OLDERR: $!";
return ($rv, $output, $errors);
}
1; # so the require or use succeeds

View File

@@ -231,11 +231,22 @@ sub checkout {
# Extract the content and version.
if ($rv == 0) {
open(FILE, "<", $self->spec) || die "Can't open $self->spec: $!";
$/ = undef;
$self->{_content} = <FILE>;
# Extract the version from the CVS/Entries file.
open(FILE, "<", $self->path . "CVS/Entries")
or die "Can't open " . $self->spec . "/CVS/Entries: $!";
my $entry = <FILE>; # just the first line, which should be all there is
close(FILE);
if ($errors =~ /VERS:\s([0-9.]+)\s/) { $self->{_version} = $1 }
$entry =~ m:^/[^/]*/([^/]*)/:;
$self->{_version} = $1;
# Extract the content from the file. In a block to localize $/
{
local $/ = undef;
open(FILE, "<", $self->spec)
or die "Can't open " . $self->spec . ": $!";
$self->{_content} = <FILE>;
close(FILE);
}
}
elsif ($errors =~ /cannot find/) {
$self->{_version} = "new";

View File

@@ -1,15 +1,18 @@
To use Doctor, first configure it by copying sample.conf to doctor.conf
and editing doctor.conf according to the instructions in it.
Then download and install the IO::Capture module from the net:
Then make sure you have the Template, AppConfig, File::Temp, Text::Diff,
Email::Valid, and MIME::Entity modules (and their dependencies), which you
can get via CPAN:
http://groups.google.com/groups?selm=yr0e8.12924%24ZC3.1033373%40newsread2.prod.itd.earthlink.net
You can install it anywhere in the Perl path; I installed it in the doctor
root directory at IO/Capture.pm.
perl -MCPAN -e"install Template, AppConfig, File::Temp, Text::Diff, Email::Valid, and MIME::Entity"
Finally, put the doctor directory into your web server's cgi-bin directory
(or another location where you can run CGI scripts) and browse to doctor.cgi.
You may also want to edit the templates in the templates/ sub-directory
to refer to your own site instead of mozilla.org's.
Note that doctor.conf may contain a CVS write password you don't want anyone
to know. The .htaccess file restricts access to that file for Apache
if this feature is enabled in .htaccess files. Check and make sure!

View File

@@ -226,9 +226,11 @@ sub queue {
Disposition => "inline",
Filename => $filename);
# Set the record separator because otherwise MIME::Entity seems
# to get stuck in an infinite loop.
$/ = "\n";
$mail->send();
# to get stuck in an infinite loop. In a block to localize $/.
{
local $/ = "\n";
$mail->send();
}
};
if ($@) {
ThrowCodeError($@, "Mail Failure");
@@ -266,9 +268,9 @@ sub commit {
$errors);
}
$vars->{file} = $file;
$vars->{output} = $output;
$vars->{errors} = $errors;
$vars->{'file'} = $file;
$vars->{'output'} = $output;
$vars->{'errors'} = $errors;
print $request->header;
$template->process("committed.tmpl", $vars)
@@ -388,7 +390,7 @@ sub GetContent {
my $fh = $request->upload('content_file');
my $content;
if ($fh) {
local $/; # enable 'slurp' mode
local $/ = undef;
$content = <$fh>;
}
if (!$content) {

View File

@@ -39,7 +39,7 @@
unable to recover. More information about the error is provided below.
Please forward this information along with any other information
that would help diagnose and fix this problem to the system administrator
at <a href="mailto:[% CONFIG.ADMIN_EMAIL %]">[% CONFIG.ADMIN_EMAIL %]</a>.
at <a href="mailto:[% config.ADMIN_EMAIL %]">[% config.ADMIN_EMAIL %]</a>.
</p>
<p>[% message %]</p>

View File

@@ -49,7 +49,7 @@
<form id="form" method="post" action="doctor.cgi" enctype="multipart/form-data">
<input id="file" type="hidden" name="file" value="[% file.spec FILTER html %]">
<input id="version" type="hidden" name="version" value="[% version %]">
<input id="version" type="hidden" name="version" value="[% file.version %]">
<h1>
Doctor - [% is_new ? "create" : "edit" %]