The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#$Id: Directives2.pm 97 2007-06-17 13:18:56Z zag $

package Apache::Directives2;

use strict;
use warnings FATAL => 'all';
use Apache::Test;
use Apache::TestUtil;

use Apache2::Const -compile => qw(OR_ALL RAW_ARGS ITERATE TAKE1);
use Apache2::CmdParms  ();
use Apache2::Module    ();
use Apache2::Directive ();
use Data::Dumper;

sub define_d {
    my $name   = shift;
    my $const  = shift;
    my $pkg    = __PACKAGE__;
    my $method = ( $const == Apache2::Const::TAKE1 ) ? 'set_val' : 'set_pars_val';
    my $code   = qq{
    package $pkg;
    sub $name { 
      return \&$method('$name',\@_)
    }
  };
    eval $code;
    die @! if @!;
    return { name => $name, args_how => $const };
}
my @directives = (
    map { &define_d( $_->[0], $_->[1] ) } (
        [ 'wdStore'    => Apache2::Const::TAKE1 ],
        [ 'wdStorePar' => Apache2::Const::RAW_ARGS ],
        [ 'wdSession'  => Apache2::Const::TAKE1 ],
        [ wdSessionPar => Apache2::Const::RAW_ARGS ],
        [ wdIndexFile  => Apache2::Const::TAKE1 ],
    )
);

Apache2::Module::add( __PACKAGE__, \@directives );

sub _SERVER_MERGE { merge(@_) }
sub _DIR_MERGE    { merge(@_) }

sub _parse_str_to_hash {
    my $str = shift;
    my %hash = map { split( /=/, $_ ) } split( /;/, $str );
    foreach ( values %hash ) {
        s/^\s+//;
        s/\s+^//;
    }
    \%hash;
}

sub set_val {
    my ( $name, $self, $parms, $arg ) = @_;
    $self->{$name} = $arg;
}

sub set_pars_val {
    my ( $name, $self, $parms, $arg ) = @_;
    return &set_val( $name, $self, $parms, &_parse_str_to_hash($arg) );
}

sub merge {
    my ( $base, $add ) = @_;
    my %mrg = ();
    die "aaa";
    print STDERR "MERGE:"
      . Dumper( { 'keys %$base' => [ keys %$base ], 'keys %$add' => [ keys %$add ] } );
    for my $key ( keys %$base, keys %$add ) {
        next if exists $mrg{$key};
        $mrg{$key} = $base->{$key} if exists $base->{$key};
        $mrg{$key} = $add->{$key}  if exists $add->{$key};
    }
    return bless \%mrg, ref($base);
}
1;