summaryrefslogtreecommitdiffabout
authorSergey Poznyakoff <gray@gnu.org>2018-02-22 14:17:11 (GMT)
committer Sergey Poznyakoff <gray@gnu.org>2018-02-22 14:17:11 (GMT)
commita69997afd7c96a6f6c91a6a88653c37387b09190 (patch) (side-by-side diff)
tree11802f0584b088729127814ff561993109f0b86b
parentc16f2363476167d59a2eaad38ef9e98f032ebdd1 (diff)
downloadapache-defaults-a69997afd7c96a6f6c91a6a88653c37387b09190.tar.gz
apache-defaults-a69997afd7c96a6f6c91a6a88653c37387b09190.tar.bz2
Provide alternative error handling
New constructor parameter on_error controls error handling.
Diffstat (more/less context) (ignore whitespace changes)
-rw-r--r--lib/Apache/Defaults.pm103
1 files changed, 72 insertions, 31 deletions
diff --git a/lib/Apache/Defaults.pm b/lib/Apache/Defaults.pm
index 08c4865..b980333 100644
--- a/lib/Apache/Defaults.pm
+++ b/lib/Apache/Defaults.pm
@@ -13,9 +13,16 @@ our $VERSION = '0.10';
sub new {
my $class = shift;
- my $self = bless {}, $class;
+ my $self = bless { on_error => 'croak' }, $class;
local %_ = @_;
my $v;
+
+ if (my $v = delete $_{on_error}) {
+ croak "invalid on_error value"
+ unless grep { $_ eq $v } qw(croak return);
+ $self->{on_error} = $v;
+ }
+
my @servlist;
if ($v = delete $_{server}) {
if (ref($v) eq 'ARRAY') {
@@ -30,6 +37,9 @@ sub new {
if (my @select = grep { -x $_->[0] }
map { [ shellwords($_) ] } @servlist) {
$self->{server} = shift @select;
+ } elsif ($self->{on_error} eq 'return') {
+ $self->{status} = 127;
+ $self->{error} = "No suitable httpd binary found";
} else {
croak "No suitable httpd binary found";
}
@@ -38,12 +48,22 @@ sub new {
my $env = Shell::GetEnv->new('sh', ". $v",
{ startup => 0 });
if ($env->status) {
- croak "Got status ".$env->status." trying to inherit environment";
+ if ($self->{on_error} eq 'return') {
+ $self->{status} = $env->status;
+ $self->{error} = "Failed to inherit environment";
+ } else {
+ croak sprintf("Got status %d trying to inherit environment",
+ $env->status);
+ }
}
$self->{environ} = $env->envs;
}
croak "unrecognized arguments" if keys(%_);
+
+ $self->_get_version_info unless $self->status;
+ $self->_get_module_info unless $self->status;
+
return $self;
}
@@ -67,16 +87,22 @@ sub probe {
last unless &{$cb}($_);
}
waitpid($pid, 0);
- if ($? == -1) {
- croak "failed to execute " .$self->server . ": $!";
- } elsif ($? & 127) {
- croak sprintf("%s died with signal %d%s",
- $self->server, $? & 127,
- ($? & 128) ? ' (core dumped)' : '');
- } elsif (my $code = $? >> 8) {
- local $/ = undef;
- croak sprintf("%s terminated with status %d; error message: %s",
- $self->server, $code, <$err>);
+ if ($self->{on_error} eq 'croak') {
+ if ($? == -1) {
+ croak "failed to execute " .$self->server . ": $!";
+ } elsif ($? & 127) {
+ croak sprintf("%s died with signal %d%s",
+ $self->server, $? & 127,
+ ($? & 128) ? ' (core dumped)' : '');
+ } elsif (my $code = $? >> 8) {
+ local $/ = undef;
+ croak sprintf("%s terminated with status %d; error message: %s",
+ $self->server, $code, <$err>);
+ }
+ } elsif ($?) {
+ local $/ = undef;
+ $self->{status} = $?;
+ $self->{error} = <$err>;
}
}
close $nullin;
@@ -94,8 +120,7 @@ sub dequote {
sub _get_version_info {
my $self = shift;
- unless ($self->{has_version_info}) {
- $self->probe(sub {
+ $self->probe(sub {
local $_ = shift;
if (m{^Server version:\s+(.+?)/(\S+)\s+\((.*?)\)}) {
$self->{name} = $1;
@@ -129,11 +154,10 @@ sub _get_version_info {
}
return 1;
}, '-V');
- }
- $self->{has_version_info} = 1;
}
-my @ATTRIBUTES = qw(name
+my @ATTRIBUTES = qw(status error
+ name
version
platform
built
@@ -146,11 +170,7 @@ my @ATTRIBUTES = qw(name
{
no strict 'refs';
foreach my $attribute (@ATTRIBUTES) {
- *{ __PACKAGE__ . '::' . $attribute } = sub {
- my $self = shift;
- $self->_get_version_info;
- $self->{$attribute};
- }
+ *{ __PACKAGE__ . '::' . $attribute } = sub { shift->{$attribute} }
}
}
@@ -158,7 +178,6 @@ sub server_root { shift->defines('HTTPD_ROOT') }
sub defines {
my $self = shift;
- $self->_get_version_info;
if (@_) {
return @{$self->{defines}}{@_};
}
@@ -290,7 +309,6 @@ my %modlist = (
sub preloaded {
my $self = shift;
- $self->_get_module_info;
if (@_) {
return @{$self->{preloaded}}{@_};
}
@@ -299,8 +317,7 @@ sub preloaded {
sub _get_module_info {
my $self = shift;
- unless ($self->{has_module_info}) {
- $self->probe(sub {
+ $self->probe(sub {
local $_ = shift;
# print "GOT $_\n";
if (/^\s*(\S+\.c)$/ && exists($modlist{$1})) {
@@ -308,8 +325,6 @@ sub _get_module_info {
}
return 1;
}, '-l');
- $self->{has_module_info} = 1;
- }
}
1;
@@ -371,12 +386,38 @@ in file F</etc/apache2/envvars>. This attribute is intended to cope with
such problems, e.g.:
$x = new Apache::Defaults(environ => /etc/apache2/envvars)
-
+
+=item C<on_error>
+
+Controls the error handling. Allowed values are C<croak> and C<return>.
+If the value is C<croak> (the default), the method will I<croak> if an
+error occurs. If set to C<return>, the constructor will return a valid
+object. The B<httpd> exit status and diagnostics emitted to the stderr
+will be available via the B<status> and B<error> methods.
+
=back
The method will I<croak> if an error occurs (e.g. the server binary
is not found or exits with failure).
+=head2 status
+
+ $x = new Apache::Defaults(on_error => 'return');
+ if ($x->status) {
+ die $x->error;
+ }
+
+Returns the status of the last B<httpd> invocation (i.e. the value of
+the B<$?> perl variable after B<waitpid>). The caller should inspect
+this value, after constructing an B<Apache::Defaults> object with
+the C<on_error> attribute set to C<return>.
+
+=head2 error
+
+Returns additional diagnostics if B<$x-E<gt>status != 0>. Normally, these are
+diagnostic messages that B<httpd> printed to standard error before
+termination.
+
=head2 server
$s = $x->server;
@@ -387,11 +428,11 @@ Returns the pathname of the B<httpd> binary.
@cmd = $x->server_command;
-Returns full command line of the B<httpd> binary.
+Returns the full command line of the B<httpd> binary.
=head2 environ
- $hashref = $x->environ
+ $hashref = $x->environ;
Returns a reference to the environment used when invoking the server.

Return to:

Send suggestions and report system problems to the System administrator.