The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

# pragmata
use 5.006;
use strict;
use warnings;

# CPAN modules
use File::Basename;
use File::Which;
use Getopt::Long;
use IO::All;
use Log::Dispatch::Email::MIMELite;
use Log::Log4perl;
use Pod::Usage;
use Switch;
use Template;

our $VERSION = '1.06';

# process command line options
my(%clo);
Getopt::Long::config('no_ignore_case');
Getopt::Long::GetOptions(\%clo, qw(all|a conf_file|f=s debug|d help|h man|m httpd_opt|o=s template|t=s log_file|l=s))
	or pod2usage(-exitval => 10, -verbose => 0);

setup_logger(\%clo);
my $log = Log::Log4perl->get_logger();

$clo{help} and pod2usage(1);
$clo{man}  and pod2usage(-verbose => 2);
$clo{conf_file} or $log->logdie("You must supply a configuration file!\n");

@ARGV or pod2usage(-exitval => 9, -verbose => 1);

exit httpd_ctl($clo{conf_file});

sub httpd_ctl {
	my($httpdconf) = @_;

	$log->debug("Processing file $httpdconf\n");

	my $httpd_opt    = $clo{httpd_opt} || "";

	unless(-r $httpdconf) {
		$log->warn("HTTPDCONF file $httpdconf is not readable!\n");
		return 1;
	}

	# Pass config file through Template Toolkit if required
	if ($clo{template} or $httpdconf =~ m/\.tt$/) {
		$httpdconf = tt_process_file($httpdconf) or return 1;
	}

	my $httpd     = which('httpd') or $log->logdie('Unable to find httpd executable, please update your path');
	$httpd       .= " -f $httpdconf";

	$log->debug("Using httpd commandline $httpd\n");

	my $arg = $ARGV[0];

	switch($arg) {

		case m/^(?:graceful|restart|start|stop)$/ {
			run_httpd($httpd, $arg) or return 1;
		}

		case /^coldrestart$/ {
			# First stop the server
			run_httpd($httpd, 'stop')  or $log->logwarn("Unable to stop httpd\n") and return 1;
			sleep(5);  #wait a bit for all the children to shutdown
			run_httpd($httpd, 'start') or $log->logwarn("Unable to start httpd\n") and return 1;
		}

		case m/^configtest$/ {
			system("$httpd -t 2>&1 | perl -ne 'print unless /syntax ok/i' 1>&2") == 0
			  or return 1;
			if(grep(/(?>!\#.*)VirtualHost/, io($httpdconf)->slurp)) {
				print "Checking virtual host settings...\n";
				system("$httpd -S 2>&1") == 0 or return 1;
			}
		}

		else {
			pod2usage(2);
		}

	}
	return 0;
}

sub run_httpd {
	my($httpd, $action) = @_;

	$httpd .= " -k $action";

	# If running with the -X option the httpd will not put itself into the
	# background, need to do this ourselves
	$httpd .= " \&";


	if (system($httpd) == 0) {
		return 1;
	}
	else {
		$log->warn("httpd could not be started: $!\n");
		return 0;
	}
}

sub tt_process_file($) {
	my($infile) = @_;

	my $outfile = "$infile.processed";

	$log->debug("Template Toolkit processing $infile, output to $outfile\n");

	# Process the files
	my $tt = Template->new({
			ABSOLUTE  => 1,
			EVAL_PERL =>1,
			RELATIVE  => 1,
		});

	$tt->process($infile, {}, $outfile) or $log->warn("Template Toolkit Error processing $infile: " . $tt->error . "\n")  and return;

	return $outfile;
}

#=for internaldocs
#
#	 setup_logger( $rh_args );
#
#Setup a Log4perl logger using the specified arguments.
#
#	 debug         - boolean denoting whether or not to log debugging messages
#
#	 email         - address to send email including all warnings, errors, and
#									 fatal errors
#
#	 email_subject - subject of email (default is "$PROGRAM_NAME Errors")
#
#	 log_file      - file to write logged messages to
#
#This configuration prefixes each non info message with a symbol depending on its log level:
#
#=over 4
#
#=item %
#
#debug
#
#=item !
#
#warn
#
#=item !!
#
#error
#
#=item !!!
#
#fatal
#
#=back
#
#debug and info level messages which are sent to the screen are sent to STDOUT;
#all higher level messages which are sent to the screen are sent to STDERR.
#
#=cut

sub setup_logger {

	my $rh_args = shift;
	my %args    = ref $rh_args ? %$rh_args : ();

	$args{diagnostics} ||= $args{debug};  # alternative name

	my %symbols = (
		WARN  => '! ',
		ERROR => '!! ',
		FATAL => '!!! ',
		DEBUG => '% ',
	);

	Log::Log4perl::Layout::PatternLayout::add_global_cspec(
		'S',
		sub { $symbols{ $_[3] } || '' },
	);

	my %logger_cfg;

	$logger_cfg{'log4perl.logger'} = 'DEBUG, Stdout, Stderr';

	if ( $args{log_file} ) {
		$logger_cfg{'log4perl.logger'                                   } .= ', Logfile';

		$logger_cfg{'log4perl.filter.MatchLog'                          }  = 'Log::Log4perl::Filter::LevelRange';
		$logger_cfg{'log4perl.filter.MatchLog.LevelMin'                 }  = $args{diagnostics} ? 'DEBUG' : 'INFO';
		$logger_cfg{'log4perl.filter.MatchLog.LevelMax'                 }  = 'FATAL';
		$logger_cfg{'log4perl.filter.MatchLog.AcceptOnMatch'            }  = 'true';

		$logger_cfg{'log4perl.appender.Logfile'                         }  = 'Log::Log4perl::Appender::File';
		$logger_cfg{'log4perl.appender.Logfile.Filter'                  }  = 'MatchLog';
		$logger_cfg{'log4perl.appender.Logfile.filename'                }  = $args{log_file};
		$logger_cfg{'log4perl.appender.Logfile.mode'                    }  = 'write';
		$logger_cfg{'log4perl.appender.Logfile.layout'                  }  = 'Log::Log4perl::Layout::PatternLayout';
		$logger_cfg{'log4perl.appender.Logfile.layout.ConversionPattern'}  = '%-5p %d{yyyyMMdd HH:mm:ss} %m';
	}

	$logger_cfg{'log4perl.filter.MatchInfo'                        } = 'Log::Log4perl::Filter::LevelRange';
	$logger_cfg{'log4perl.filter.MatchInfo.LevelMin'               } = $args{diagnostics} ? 'DEBUG' : 'INFO';
	$logger_cfg{'log4perl.filter.MatchInfo.LevelMax'               } = 'INFO';
	$logger_cfg{'log4perl.filter.MatchInfo.AcceptOnMatch'          } = 'true';

	$logger_cfg{'log4perl.filter.MatchNotInfo'                     } = 'Log::Log4perl::Filter::LevelRange';
	$logger_cfg{'log4perl.filter.MatchNotInfo.LevelMin'            } = 'WARN';
	$logger_cfg{'log4perl.filter.MatchNotInfo.LevelMax'            } = 'FATAL';
	$logger_cfg{'log4perl.filter.MatchNotInfo.AcceptOnMatch'       } = 'true';

	$logger_cfg{'log4perl.appender.Stdout'                         } = 'Log::Log4perl::Appender::Screen';
	$logger_cfg{'log4perl.appender.Stdout.stderr'                  } = 0;
	$logger_cfg{'log4perl.appender.Stdout.Filter'                  } = 'MatchInfo';
	$logger_cfg{'log4perl.appender.Stdout.layout'                  } = 'Log::Log4perl::Layout::PatternLayout';
	$logger_cfg{'log4perl.appender.Stdout.layout.ConversionPattern'} = '%S%m';

	$logger_cfg{'log4perl.appender.Stderr'                         } = 'Log::Log4perl::Appender::Screen';
	$logger_cfg{'log4perl.appender.Stderr.stderr'                  } = 1;
	$logger_cfg{'log4perl.appender.Stderr.Filter'                  } = 'MatchNotInfo';
	$logger_cfg{'log4perl.appender.Stderr.layout'                  } = 'Log::Log4perl::Layout::PatternLayout';
	$logger_cfg{'log4perl.appender.Stderr.layout.ConversionPattern'} = '%S%m';

	if ($args{email} ) {
		$logger_cfg{'log4perl.logger'                                 } .= ', Email';
		$logger_cfg{'log4perl.appender.Email'                         }  = 'Log::Dispatch::Email::MIMELite';
		$logger_cfg{'log4perl.appender.Email.to'                      }  = $args{email};
		$logger_cfg{'log4perl.appender.Email.subject'                 }  = $args{email_subject} || basename( $0 ) . " Errors";
		$logger_cfg{'log4perl.appender.Email.layout'                  }  = 'Log::Log4perl::Layout::PatternLayout';
		$logger_cfg{'log4perl.appender.Email.layout.ConversionPattern'}  = '%m';
		$logger_cfg{'log4perl.appender.Email.Filter'                  }  = 'MatchNotInfo';
	}

	Log::Log4perl->init( \%logger_cfg );
}

__END__



=head1 NAME

httpd_ctl - An apache httpd control script that supports Template Toolkit
pre-processing

=head1 SYNOPSIS

B<httpd_ctl>
[B<--all|-a>]
[B<--batch|-b>]
[B<--conf_file|-f> I<httpd.conf file>]
[B<--debug|-d>]
[B<--help|-h>]
[B<--man|-m>]
[B<--template|-t>]
		 (start|stop|coldrestart|restart|graceful|configtest)+

=head1 DESCRIPTION

An apache httpd control script that supports Template Toolkit pre-processing

=head1 OPTIONS

=over 4

=item B<--conf_file|-f> I<httpd.conf file>

If file extension is .tt automatically implies --template

=item B<--debug|-d>

prints debug messages

=item B<--help|-h>

prints out usage information and exits

=item B<--httpd_opt|-o> I<options>

A quoted string specifying any additional options to pass through to the httpd.

=item B<--man|-m>

produces man page

=item B<--template|-t>

Requires the  --conf_file file to be processed  by Template Toolkit. The
processed file will be placed in the same directory .

This allows you to do things like environment variable substitution:

 [% USE env = EnvHash %]
 [% env.MY_LOG_DIR %]

It is that simple!

But, remember  you can do much more  powerful things with  Template Toolkit,
and use variables in control   structures such as if,  for,  foreach and so on.
See http://www.template-toolkit.org/ to read about Template Toolkit in full.

=item B<start>

start httpd

=item B<stop>

stop httpd

=item B<coldrestart>

stop the httpd and then start it

=item B<restart>

Restart httpd if running by sending a SIGHUP or start if not running

=item B<graceful>

Do a graceful restart by sending a SIGUSR1 or start if not running

=item B<configtest>

Do a configuration syntax test and check virtual hosts.

=back

=head1 EXIT STATUS

	0 - Completed Successfully
	1 - Otherwise

=head1 See Also

Template

=head1 AUTHOR

Sagar R. Shah

=head1 COPYRIGHT & LICENSE

Copyright 2006-2007 Sagar R. Shah, All Rights Reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut