package Apache::ParseSource;

use strict;
use Apache::Build ();
use Config ();
use Data::Dumper ;

our $VERSION = '0.02';

use vars qw{@ISA} ;

use ExtUtils::XSBuilder::ParseSource  ;

@ISA = ('ExtUtils::XSBuilder::ParseSource') ;



sub new {
    my $self = ExtUtils::XSBuilder::ParseSource::new (@_) ;
    $self -> {config} = Apache::Build->build_config ;

    $Apache::Build::APXS ||= $self->{apxs};

    my $prefixes = join '|', @{ $self->{prefixes} || [qw(ap_ apr_)] };
    $self->{prefix_re} = qr{^($prefixes)};

    $self;
}


sub config {
    shift->{config};
}


sub include_dirs {
    my $self = shift;
    my @dirs = ($self->config->apxs(-q => 'INCLUDEDIR'),
     $self->config->mp_include_dir);
    print "Search all headers in:\n" . join ("\n  ", @dirs) ."\n" ;
    return @dirs ;
}


sub unwanted_includes {
    return [qw(ap_listen internal version
                                apr_optional mod_include mod_cgi mod_proxy
                                mod_ssl ssl_)] ;
}


sub includes { shift->config->includes }


sub sort_includes {
    my $self     = shift ;
    my $includes = shift ;
    #include apr_*.h before the others
    my @wanted = grep { /apr_\w+\.h$/ } @$includes;
    push @wanted, grep { !/apr_\w+\.h$/ } @$includes;

    return \@wanted ;
}

sub preprocess {
    my $self     = shift ;

    $_[0] =~ s/(?:AP|APR|APU|DAV)(?:_CORE)?_DECLARE(?:_NONSTD)?\s*\(\s*(.*?)\s*\)/$1/g ;


    # from apr_ring.h
    $_[0] =~ s/APR_RING_ENTRY\s*\((.*?)\)/struct { struct $1 *next; struct $1 *prev }/g ;
    $_[0] =~ s/APR_RING_HEAD\s*\((.*?),(.*?)\)/struct $1 ring; struct $1 *ringp;/g ;

    # from apr_pools.h 
    $_[0] =~ s/APR_POOL_DECLARE_ACCESSOR\s*\((.*?)\)/apr_pool_t * apr_${1}_pool_get (const apr_${1}_t *ob)/g ;

    $_[0] =~ s/MP_INLINE//g ;


}


sub extent_parser {
    my $self     = shift ;
    my $parser = shift ;

    $parser -> Replace ( q{

    function_declaration_attr: function_declaration_attr_apache | function_declaration_attr_none

    function_declaration_attr_apache:      '__attribute__' m{[^;]+}x

    function_declaration_attr_none:

    }) ;

    $parser -> Extend ( q{

    prepart:

	'AP_DECLARE_HOOK' '(' rtype ',' IDENTIFIER ',' '(' <leftop: arg_decl ',' arg_decl>(s?) ')' ')' 
            {
            print "AP_DECLARE_HOOK found in $thisparser->{srcfilename} line $thisline\n" ;
            cdef_function_declaration ($thisparser, "ap_hook_get_$item[5]", 'apr_array_header_t *', []) ;
            cdef_function_declaration ($thisparser, "ap_hook_$item[5]", 'void', 
                    [
                        ["ap_HOOK_$item[5]_t *", 'pf'],
                        ["const char * const *", 'aszPre'],
                        ["const char * const *", 'aszSucc'],
                        ["int", 'nOrder'],
                    ]) ;
            cdef_struct ($thisparser, "ap_LINK_$item[5]", "struct ap_LINK_$item[5]",  
                    [
                        ["ap_HOOK_$item[5]_t *", 'pFunc'],
                        ["const char *", 'szName'],
                        ["const char * const *", 'aszPredecessors'],
                        ["const char * const *", 'aszSuccessors'],
                        ["int", 'nOrder'],
                    ]) ;
            cdef_function_declaration ($thisparser, "ap_run_$item[5]", $item[3], $item[8]) ;
            }


    }) ;



}



my $filemode = join '|',
  qw{READ WRITE CREATE APPEND TRUNCATE BINARY EXCL BUFFERED DELONCLOSE};

my %defines_wanted = (
    Apache => {
        common     => [qw{OK DECLINED DONE}],
        methods    => [qw{M_ METHODS}],
        options    => [qw{OPT_}],
        satisfy    => [qw{SATISFY_}],
        remotehost => [qw{REMOTE_}],
        http       => [qw{HTTP_}],
#       config     => [qw{DECLINE_CMD}],
#       types      => [qw{DIR_MAGIC_TYPE}],
        override   => [qw{OR_ ACCESS_CONF RSRC_CONF}],
        log        => [qw(APLOG_)],
    },
    APR => {
        poll      => [qw{APR_POLL}],
        common    => [qw{APR_SUCCESS}],
        error     => [qw{APR_E}],
        fileperms => [qw{APR_\w(READ|WRITE|EXECUTE)}],
        finfo     => [qw{APR_FINFO_}],
        filepath  => [qw{APR_FILEPATH_}],
        filemode  => ["APR_($filemode)"],
        flock     => [qw{APR_FLOCK_}],
        socket    => [qw{APR_SO_}],
        limit     => [qw{APR_LIMIT}],
        hook      => [qw{APR_HOOK_}],
        uri       => [qw{APR_URI_}],
    },
);

my %defines_wanted_re;
while (my($class, $groups) = each %defines_wanted) {
    while (my($group, $wanted) = each %$groups) {
        my $pat = join '|', @$wanted;
        $defines_wanted_re{$class}->{$group} = $pat; #qr{^($pat)};
    }
}

my %enums_wanted = (
    Apache => { map { $_, 1 } qw(cmd_how input_mode filter_type) },
    APR => { map { $_, 1 } qw(apr_shutdown_how apr_read_type) },
);

my $defines_unwanted = join '|', qw{
HTTP_VERSION APR_EOL_STR APLOG_MARK
};



sub handle_define {
    my ($self, $item) = @_ ;

    my $name = $item -> {name} ;
    my $keys = keys %defines_wanted_re; #XXX broken bleedperl ?

    return undef if $name =~ /^($defines_unwanted)/o;

    while (my($class, $groups) = each %defines_wanted_re) {
        my $keys = keys %$groups; #XXX broken bleedperl ?

        while (my($group, $re) = each %$groups) {
            next unless $name =~ /^($re)/;
            $item->{class}, $class;
            $item->{group}, $group;
            return 1 ;
        }
    }
    return undef ;
}




sub handle_enum {
    my ($self, $item) = @_ ;

    my $name = $item -> {name} ;

    $name =~ s/^ap_//;
    $name =~ s/_(e|t)$//;

    my $class;
    for (keys %enums_wanted) {
        next unless $enums_wanted{$_}->{$name};
        $class = $_;
    }

    return undef unless $class;
    $name =~ s/^apr_//;

    $item->{class}, $class;
    $item->{group}, $name ;
    return 1 ;
    #push @{ $constants->{$class}->{$name} }, @$e if $e;
}


sub handle_function 
    { 
    my ($self, $item) = @_ ;

    return 1 if ($item -> {name} =~ /$self->{prefix_re}/o) ;
    return undef ;
    }


my $other_struct  = join '|', qw(_rec module
                              piped_log uri_components htaccess_result
                              cmd_parms cmd_func cmd_how);



sub handle_struct  
    { 
    my ($self, $item) = @_ ;

    my $type = $item -> {type} ;
    $type =~ s/^struct\s+// ;

    #return ($item =~ /$self->{prefix_re}/o) || ($item =~ /$other_struct/o) if (!ref $item) ;
    return undef if (($type !~ /$self->{prefix_re}/o) && ($type !~ /$other_struct/o)) ;
    return 1 ;
    }



sub package { 'Apache' } 

sub targetdir { 'xsbuilder/tables' }


1;
__END__
