package Apache::TrafficCop;
use strict;
use Apache::Constants qw(:common);
use Apache::ModuleConfig ();
use DynaLoader ();

if($ENV{MOD_PERL}) {
  no strict;
  @ISA = qw(DynaLoader);
  __PACKAGE__->bootstrap;
}

sub DIR_MERGE {
    my($base, $add) = @_;
    my %new = (%$base,%$add);
    return bless \%new, ref($base);
}

my $EndToken = "</TrafficCopSpeedLimits>";

sub TrafficCopSpeedLimits ($$$;*) {
    my($cfg, $parms, $district, $cfg_fh) = @_;
    $district =~ s/>$//;
    while((my $line = <$cfg_fh>) !~ m:^$EndToken:o) {
        my($road, $limit) = ($line =~ /(.*)\s+(\S+)$/);
        $cfg->{SpeedLimits}{$district}{$road} = $limit;
    }
}

sub TrafficCopSpeedLimits_END () {
    die "$EndToken outside a <TrafficCopSpeedLimits> container\n";
}

sub TrafficCopTicket ($$@;@) {
    my($cfg, $parms, $violation, $day) = @_;
    push @{ $cfg->{Ticket}{$violation} }, $day;
}

sub TrafficCopRoadBlock ($$$) {
    my($cfg, $parms, $arg) = @_;
    $cfg->{RoadBlock} = $arg;
}

sub TrafficCopActiveSergeant ($$$) {
    my($cfg, $parms, $arg) = @_;
    $cfg->{Sergeant} = $arg;
    my $chief_of_police = $parms->server->server_admin;
    $cfg->{ChiefOfPolice} = $chief_of_police;
}

sub TrafficCopSpeedLimit ($$$) {
    my($cfg, $parms, $arg) = @_;
    $cfg->{SpeedLimit} = $arg;
}

sub right_of_way ($$@) {
    my($cfg, $parms, $domain) = @_;
    my $pat = $parms->info;
    unless ($domain =~ /^$pat$/i) {
	die "Invalid domain: $domain ($pat)\n";
    }
    $cfg->{RightOfWay}{$domain}++;
}

my $Class = __PACKAGE__;

sub test {
    my $r = shift;
    $r->send_http_header('text/plain');
    require Data::Dumper;
    my $cfg = Apache::ModuleConfig->get($r);
    print "$Class configuration:\n";
    print Data::Dumper::Dumper($cfg) if $cfg;
}

1;
__END__