http://search.cpan.org/~rsoliv/Apache-Admi...Admin/Config.pm
делать ли такую большую программу? чтобы конфигурировать всем веб сервером?
для работы нужен веб сервер, не много есть я написал уже, пример:
apache-config
(не доделано, проверено на opera,firefox2)
подробно
Код:
use Apache::Admin::Config;
my $conf = new Apache::Admin::Config '/$qhost',
or die $Apache::Admin::Config::ERROR;
my $vhost;
my %templ_value;
my $templ_value;
my ( $serveradmin, $serveralis, $costomlog, $errorlog, @drtvs4 );
foreach my $vh ( $conf->section('VirtualHost') ) {
if ( $vh->directive('ServerName')->value eq $nameserver ) {
$serveradmin = $vh->directive('ServerAdmin');
$serveralis = $vh->directive('ServerAlias');
$costomlog = $vh->directive('CustomLog');
$errorlog = $vh->directive('ErrorLog');
@drtvs4 = $vh->directive('ErrorDocument');
}
}
my $template = HTML::Template->new(
filename => $dir . 'tempele-apache22-aid.html',
die_on_bad_params => '0'
);
my $url = $query->url( -relative => 1 );
$template->param( URL => $url );
$template->param( AID => $aid );
if ( defined($saa) ) {
if ($serveradmin) {
use Data::Validate::Email qw(is_email);
if (
(
( length($saa) )
&& ( 70 > length($saa) )
&& ( 5 < length($saa) )
)
&& ( is_email($saa) )
)
{
foreach my $vh ( $conf->section('VirtualHost') ) {
if ( $vh->directive('ServerName')->value eq $nameserver ) {
$vh->directive('ServerAdmin')->set_value($saa);
}
}
$conf->save;
#my $okssa="ok add ServerAdmin";
}
else { %templ_value = ( 'errorsa' => 1 ); }
} #else { $vh->add_directive(ServerAdmin => $saa) } }
if ($serveradmin) {
#my ($serveradmin);
# my $serveradmin=$vh->directive('ServerAdmin');
%templ_value = ( serveradmin => $serveradmin );
}
else { %templ_value = ( 'noserverserveradmin' => '1' ); }
$template->param( NOSERVERADMIN => $templ_value{'noserverserveradmin'} );
$template->param( SERVERADMIN => $templ_value{'serveradmin'} );
$template->param( ERRORSA => $templ_value{'errorsa'} );
my $addsa = $query->param("addsa");
if ( defined($addsa) ) {
use Data::Validate::Domain qw(is_domain);
if ( ( ( 70 > length($addsa) ) && ( 4 < length($addsa) ) )
&& ( is_domain($addsa) ) )
{
if ($serveralis) {
#my $serveralis=$vh->directive('ServerAlias');
my @serv_array = split( / /, $serveralis );
my $n = scalar(@serv_array);
my ( $match, $found, $item );
foreach $item (@serv_array) {
if ( $item eq $addsa ) { $match = $item; $found = 1; last; }
}
if ( !$found ) {
$serv_array[$n] = $addsa;
my $addsa2 = join( ' ', @serv_array );
foreach my $vh ( $conf->section('VirtualHost') ) {
if (
$vh->directive('ServerName')->value eq $nameserver )
{
$vh->directive('ServerAlias')->set_value($addsa2);
}
}
$conf->save;
}
else { %templ_value = ( 'addsa_found' => '1' ); }
}
}
else { %templ_value = ( 'addsa_noval' => '1' ); }
}
my $sadelete = $query->param("sadelete");
if ( defined($sadelete) ) {
if ($serveralis) {
my @serv_array;
@serv_array = split( / /, $serveralis );
my $n = scalar(@serv_array);
delete( @serv_array[$sadelete] );
my $addsa2 = join( ' ', @serv_array );
foreach my $vh ( $conf->section('VirtualHost') ) {
if ( $vh->directive('ServerName')->value eq $nameserver ) {
$vh->directive('ServerAlias')->set_value($addsa2);
}
}
$conf->save;
}
}
my $allsa = $query->param("allsa");
if ( defined($allsa) ) {
my $satooall = $query->param("satooall");
if ($serveralis) {
$satooall = $query->param("satooall");
my @serv_array;
@serv_array = split( / /, $serveralis );
my $n = scalar(@serv_array);
my $ss = "*.$nameserver";
if ( ( defined($satooall) ) && ( $satooall eq "1" ) ) {
if ( ( $n eq '2' ) && ( $serv_array[1] eq $ss ) ) {
%templ_value = ( 'satooall_in_use' => '1' );
}
else {
my $allsa2 = "$nameserver2 $ss";
foreach my $vh ( $conf->section('VirtualHost') ) {
if (
$vh->directive('ServerName')->value eq $nameserver )
{
$vh->directive('ServerAlias')->set_value($allsa2);
}
}
$conf->save;
}
}
elsif ( ( defined($satooall) ) && ( $satooall eq "2" ) ) {
if ( ( $n > 0 ) && ( $serv_array[1] ne $ss ) ) {
%templ_value = ( 'nosatooall_in_use' => '1' );
}
else {
my $allsa2 = $nameserver2;
foreach my $vh ( $conf->section('VirtualHost') ) {
if (
$vh->directive('ServerName')->value eq $nameserver )
{
$vh->directive('ServerAlias')->set_value($allsa2);
}
}
$conf->save;
}
}
else { %templ_value = ( 'no_satooall_param' => '1' ); }
}
}
my ( @serv_array, @array_for_template );
if ($serveralis) {
@serv_array = split( / /, $serveralis );
my $n = scalar(@serv_array);
my $ss = "*.$nameserver";
shift(@serv_array);
my $ns = 1;
@array_for_template;
@array_for_template =
map +{ savalue => $_, savalue2 => $aid, savalue3 => $ns++ },
@serv_array;
if ( ( $n eq 2 ) && ( $serv_array[1] eq $ss ) ) {
%templ_value = ( 'temlp_serveralis_all' => '1' );
}
else { %templ_value = ( 'notemlp_serveralis_all' => '1' ); }
}
else { %templ_value = ( 'noserveralis' => '1' ); }
$template->param(
TEMP_SERVERALIAS_ALL => $templ_value{'temlp_serveralis_all'} );
$template->param(
NOTEMP_SERVERALIAS_ALL => $templ_value{'notemlp_serveralis_all'} );
if ( $templ_value{'addsa_found'} ) {
$template->param( ADDSA_FOUND => 'ServerAlias found, not added' );
}
$template->param( ADDSA_NOVAL => $templ_value{'addsa_noval'} );
$template->param( SATOOALL_IN_USE => $templ_value{'satooall_in_use'} );
$template->param( NOSATOOALL_IN_USE => $templ_value{'nosatooall_in_use'} );
$template->param( NO_SATOOALL_IN_USE => $templ_value{'no_satooall_param'} );
if ( $templ_value{'notemlp_serveralis_all'} ) {
$template->param( SA8 => \@array_for_template );
}
my $oneoffcl = $query->param("oneoffcl");
if ( defined($oneoffcl) ) {
my $clvalue = $query->param("clvalue");
if ( $clvalue eq '1' ) {
if ($costomlog) { %templ_value = ( 'customlog_in_use' => '1' ); }
else {
my $dircl = "/home/$qhost/log/httpd-access.log combined";
foreach my $vh ( $conf->section('VirtualHost') ) {
if ( $vh->directive('ServerName')->value eq $nameserver ) {
$vh->add_directive( CustomLog => $dircl );
}
}
$conf->save;
}
}
elsif ( $clvalue eq '2' ) {
if ($costomlog) {
foreach my $vh ( $conf->section('VirtualHost') ) {
if ( $vh->directive('ServerName')->value eq $nameserver ) {
$vh->directive('CustomLog')->delete;
}
}
$conf->save;
}
else { %templ_value = ( 'no_customlog_in_use' => '1' ); }
}
else { %templ_value = ( 'no_clvalue' => '1' ); }
}
my $type_cl = $query->param("type_cl");
if ( defined($type_cl) ) {
my $typecls = $query->param("typecls");
if ($costomlog) {
my $customl_type = $costomlog;
my ( $file, $typelog ) = split( / /, $customl_type );
if ( ( $typecls eq '0' ) && ( $typelog eq 'combined' ) ) {
%templ_value = ( 'typecls_in_use_combined' => '1' );
}
elsif ( ( $typecls eq '0' ) && ( $typelog ne 'combined' ) ) {
my $typecls_value = "$file combined";
foreach my $vh ( $conf->section('VirtualHost') ) {
if ( $vh->directive('ServerName')->value eq $nameserver ) {
$vh->directive('CustomLog')->set_value($typecls_value);
}
}
$conf->save;
}
elsif ( ( $typecls eq '1' ) && ( $typelog eq 'common' ) ) {
%templ_value = ( 'typecls_in_use_common' => '1' );
}
elsif ( ( $typecls eq '1' ) && ( $typelog ne 'common' ) ) {
my $typecls_value = "$file common";
foreach my $vh ( $conf->section('VirtualHost') ) {
if ( $vh->directive('ServerName')->value eq $nameserver ) {
$vh->directive('CustomLog')->set_value($typecls_value);
}
}
$conf->save;
}
else { %templ_value = ( 'no_typecls' => '1' ); }
}
else { %templ_value = ( 'no_cl' => '1' ); }
}
if ($costomlog) {
$template->param( CLTRUE => '1' );
my ( $file, $typelog ) = split( / /, $costomlog );
if ( $typelog eq 'combined' ) {
$template->param( CLT_CD => '1' );
}
elsif ( $typelog eq 'common' ) {
%templ_value = ( 'customlogtype_cn' => '1' );
}
else { %templ_value = ( 'nocustomlogtype' => '1' ); }
}
else { %templ_value = ( 'nocustomlog' => '1' ); }
$template->param( CLT_CN => $templ_value{'customlogtype_cn'} );
$template->param( NOCLT => $templ_value{'nocustomlogtype'} );
$template->param( NOCLTRUE => $templ_value{'nocustomlog'} );
$template->param( CL_IN_USE => $templ_value{'customlog_in_use'} );
$template->param( NO_CL_IN_USE => $templ_value{'no_customlog_in_use'} );
$template->param( NO_CLVALUE => $templ_value{'no_clvalue'} );
$template->param(
TYPE_CL_IN_USE_D => $templ_value{'typecls_in_use_combined'} );
$template->param(
TYPE_CL_IN_USE_C => $templ_value{'typecls_in_use_common'} );
$template->param( NOTYPE_CL => $templ_value{'no_typecls'} );
$template->param( NO_CL_IN_USE => $templ_value{'no_cl'} );
if ($errorlog) {
%templ_value = ( 'errorlogtrue' => '1' );
}
else { %templ_value = ( 'noerrorlog' => '1' ); }
$template->param( ERRORLOG => $templ_value{'notemlp_serveralis_all'} );
$template->param( NOERRORLOG => $templ_value{'notemlp_serveralis_all'} );
my ( $type_errord, $tttt, $match_index2, @drtvs3 );
my $error_typeer_edadd;
sub eett1 {
my ( $type_errord, $edvalue, $edtvalue ) = @_;
if ( $type_errord ne '1' ) {
use Data::Validate::URI qw(is_uri);
if ( ( !length($edvalue) )
|| ( 65 < length($edvalue) )
|| ( 5 > length($edvalue) )
|| ( !is_uri($edvalue) ) )
{
my $error_typedoc2 = "1";
$error_typedoc = \$error_typedoc2;
return $error_typedoc;
}
}
if ( ( $type_errord > 0 ) && ( ( 3 == length($edtvalue) ) ) ) {
my ( $found, $item );
my @er_array = (
100, 101, 200, 201, 202, 203, 204, 205, 206, 300,
301, 302, 303, 304, 305, 400, 401, 402, 403, 404,
405, 406, 407, 408, 409, 410, 411, 412, 413, 414,
415, 500, 501, 502, 503, 504, 505
);
foreach $item (@er_array) {
if ( $item eq $edtvalue ) { $found = 1; last; }
}
if ( !$found ) {
my $error_type2 = "1";
$error_type = \$error_type2;
return $error_type;
}
my $tttt2 = "1";
$tttt = \$tttt2;
return $tttt;
}
}
sub eett2 {
my ( $edtvalue, @drtvs4 ) = @_;
for my $loopindex ( 0 .. $#drtvs4 ) {
my ( $key, $value ) = split( / /, $drtvs4[$loopindex] );
push( @drtvs3, { $key => $value } );
}
my ( $match_key, $match_index, $found );
for my $loopindex ( 0 .. $#drtvs3 ) {
for my $key2 ( keys %{ $drtvs3[$loopindex] } ) {
if ( $key2 eq $edtvalue ) {
$drtvs3[$loopindex]{$key2};
$match_key = $key2;
$match_index = $loopindex;
$found = 1;
last;
}
}
}
print $match_index;
if ( !$found && $type_errord ne '2' ) {
my $error_typeer2 = "1";
$error_typeer = \$error_typeer2;
return $error_typeer;
}
if ( $found && $type_errord eq '2' ) {
my $error_typeer_edadd2 = "1";
$error_typeer_edadd = \$error_typeer_edadd2;
return $error_typeer_edadd;
}
$match_index2 = \$match_index;
return ( @drtvs3, $match_index2 );
}
my $eddelete = $query->param("eddelete");
my $edadd = $query->param("edadd");
my $edchange = $query->param("edchange");
if ( $eddelete || $edchange || $edadd ) {
my $edtvalue = $query->param("edtvalue");
my $edvalue = $query->param("edvalue");
if ( ( defined($eddelete) ) && (@drtvs4) ) {
$type_errord = "1";
}
elsif ( defined($edadd) ) {
$type_errord = "2";
}
elsif ( ( defined($edchange) ) && (@drtvs4) ) {
$type_errord = "3";
}
else { my $type_errord = "0"; }
eett1( $type_errord, $edvalue, $edtvalue );
if (
defined($$tttt)
&& eett2( $edtvalue, @drtvs4 )
&& ( ( defined($$match_index2) && $type_errord ne '2' )
|| ( !defined($$error_typeer_edadd) && $type_errord eq '2' ) )
)
{
if ( ( $type_errord eq '3' ) && defined($$match_index2) && @drtvs3 )
{
$drtvs3[$$match_index2] = { $edtvalue => $edvalue };
}
elsif ( ( $type_errord eq '2' ) && !defined($$error_typeer_edadd) )
{
my $match_index3;
if ( $#drtvs3 >= 0 ) { $match_index3 = $#drtvs3 + 1; }
else { $match_index3 = 0; }
print "99999 $match_index3 $#drtvs3 ";
$drtvs3[$match_index3] = { $edtvalue => $edvalue };
}
elsif (( $type_errord eq '1' )
&& defined($$match_index2)
&& @drtvs3 )
{
delete( @drtvs3[$$match_index2] );
}
else { exit; }
foreach my $vh ( $conf->section('VirtualHost') ) {
if ( $vh->directive('ServerName')->value eq $nameserver ) {
while ( $vh->directive('ErrorDocument') ) {
$vh->directive('ErrorDocument')->delete;
}
for my $loopindex2 ( 0 .. $#drtvs3 ) {
for my $key4 ( keys %{ $drtvs3[$loopindex2] } ) {
my $value_er = $drtvs3[$loopindex2]{$key4};
my $setvalue_error = "$key4 $value_er";
$vh->add_directive(
ErrorDocument => $setvalue_error );
}
}
}
}
$conf->save;
}
else {
$templ_value{'ed_error'} =
$$error_type ne '1' ? (0)
: $$error_type ne '1' ? (0)
: $$error_typeer ne '1' ? (0)
: $$error_typeer_edadd ne '1' ? (0)
: (1);
}
}
$template->param( ED_ERROR_VALUEDOC => $$error_typedoc );
$template->param( ED_ERROR_TYPEDOC => $$error_type );
$template->param( ED_ERROR_NO_USE => $$error_typeer );
$template->param( ED_ERROR_IN_USE => $$error_typeer_edadd );
$template->param( ED_ERROR => $templ_value{'ed_error'} );
my @arrayedout;
my @arrayedout2;
my @er_array = (
100, 101, 200, 201, 202, 203, 204, 205, 206, 300, 301, 302, 303, 304,
305, 400, 401, 402, 403, 404, 405, 406, 407, 408, 409, 410, 411, 412,
413, 414, 415, 500, 501, 502, 503, 504, 505
);
if (@drtvs4) {
for my $loopindex9 ( 0 .. $#drtvs4 ) {
my ( $key9, $value9 ) = split( / /, $drtvs4[$loopindex9] );
push( @arrayedout,
{ errort => $key9, erroru => $value9, aid => $aid } );
}
for my $loopindex ( 0 .. $#drtvs4 ) {
my ( $key, $value ) = split( / /, $drtvs4[$loopindex] );
push @arrayedseen, $key;
}
my %seen;
@seen{@er_array} = ();
delete @seen{@arrayedseen};
my @aonly = sort keys %seen;
if ( @aonly > 0 ) {
@arrayedout2 = map +{ errortype => $_ }, @aonly;
}
else {
%templ_value = ( 'errortype_limit' => '1' );
}
}
else {
@arrayedout2 = map +{ errortype => $_ }, @er_array;
}
if ( $templ_value{'errortype_limit'} ) {
$template->param( ERRORTYPELIMIT => $templ_value{'errortype_limit'} );
}
else { $template->param( ADDDOCUM => \@arrayedout2 ); }
$template->param( SA10 => \@arrayedout );
$template->param( AUTHORIZE => $authorize );
$template->param( WELCOME => $welcome );
$template->param( USERSE => $$session{'name'} );
спасиба за ссылку 
