libapache2-mod-perl2 2.0.8+httpd24-r1449661-6ubuntu2.1 / usr / lib / perl5 / ModPerl / MapUtil.pm

# please insert nothing before this line: -*- mode: cperl; cperl-indent-level: 4; cperl-continued-statement-offset: 4; indent-tabs-mode: nil -*-
# Licensed to the Apache Software Foundation (ASF) under one or more
# contributor license agreements.  See the NOTICE file distributed with
# this work for additional information regarding copyright ownership.
# The ASF licenses this file to You under the Apache License, Version 2.0
# (the "License"); you may not use this file except in compliance with
# the License.  You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
#
package ModPerl::MapUtil;

use strict;
use warnings;
use Exporter ();
use Apache2::Build ();

our @EXPORT_OK = qw(list_first disabled_reason
                    function_table structure_table
                    xs_glue_dirs);

our @ISA = qw(Exporter);

# the mapping happens in lib/ModPerl/StructureMap.pm: sub parse
#    '<' => 'auto-generated but gives only a read-only access'
#    '&' => 'RDWR accessor to a char* field, supporting undef arg'
#    '$' => 'RONLY accessor, with WRITE accessor before child_init'
#    '%' => like $, but makes sure that for the write accessor the
#           original perl scalar can change or go away w/o affecting
#           the object
my %disabled_map = (
    '!' => 'disabled or not yet implemented',
    '~' => 'implemented but not auto-generated',
    '-' => 'likely never be available to Perl',
    '>' => '"private" to apache',
    '?' => 'unclassified',
);

my $function_table = [];

sub function_table {
    return $function_table if @$function_table;
    push @INC, "xs/tables/current";
    require Apache2::FunctionTable;
    require ModPerl::FunctionTable;
    require APR::FunctionTable;
    @$function_table = (@$Apache2::FunctionTable, @$ModPerl::FunctionTable,
                        @$APR::FunctionTable);
    $function_table;
}

my $structure_table = [];

sub structure_table {
    return $structure_table if @$structure_table;
    require Apache2::StructureTable;
    @$structure_table = (@$Apache2::StructureTable);
    $structure_table;
}

sub disabled_reason {
    $disabled_map{+shift} || 'unknown';
}

sub xs_glue_dirs {
    Apache2::Build->build_config->mp_xs_glue_dir;
}

sub list_first (&@) {
    my $code = shift;

    for (@_) {
        return $_ if $code->();
    }

    undef;
}

package ModPerl::MapBase;

*function_table = \&ModPerl::MapUtil::function_table;
*structure_table = \&ModPerl::MapUtil::structure_table;

my @condition;

sub readline {
    my $fh = shift;

    while (<$fh>) {
        chomp;
        s/^\s+//; s/\s+$//;

        # this implements
        # #_if_ cmd
        # ...
        # #_else_
        # #_end_
        if (/^\s*#\s*_(if|unless|els(?:e|if)|end)_(?:\s(.+))?/) {
            my ($cmd, $param) = ($1, $2);
            if (defined $param) {
                while ($param=~s!\\$!!) {
                    my $l=<$fh>;
                    die "$ModPerl::MapUtil::MapFile($.): unexpected EOF\n"
                        unless defined $l;
                    chomp $l;
                    $param.=$l;
                }
            }
            if ($cmd eq 'if') {
                unshift @condition,
                    0+!!eval "#line $. $ModPerl::MapUtil::MapFile\n".$param;
                die $@ if $@;
            }
            elsif ($cmd eq 'elsif') {
                die "parse error ($ModPerl::MapUtil::MapFile line $.)".
                    " #_elsif_ without #_if_"
                    unless @condition;
                if ($condition[0] == 0) {
                    $condition[0]+=
                        !!eval "#line $. $ModPerl::MapUtil::MapFile\n".$param;
                    die $@ if $@;
                } else {
                    $condition[0]++;
                }
            }
            elsif ($cmd eq 'else') {
                die "parse error ($ModPerl::MapUtil::MapFile line $.)".
                    " #_elsif_ without #_if_"
                    unless @condition;
                $condition[0]+=1;
            }
            elsif ($cmd eq 'unless') {
                unshift @condition,
                    0+!eval "#line $. $ModPerl::MapUtil::MapFile\n".$param;
                die $@ if $@;
            }
            elsif ($cmd eq 'end') {
                shift @condition;
            }
        }
        next if @condition and $condition[0] != 1;

        if (/^\s*#\s*_(eval)_(?:\s(.+))?/) {
            my ($cmd, $param) = ($1, $2);
            if (defined $param) {
                while ($param=~s!\\$!!) {
                    my $l=<$fh>;
                    die "$ModPerl::MapUtil::MapFile($.): unexpected EOF\n"
                        unless defined $l;
                    chomp $l;
                    $param.=$l;
                }
            }
            if ($cmd eq 'eval') {
                eval "#line $. $ModPerl::MapUtil::MapFile\n".$param;
                die $@ if $@;
            }
            next;
        }

        s/\s*\#.*//;

        next unless $_;

        if (s:\\$::) {
            my $cur = $_;
            $_ = $cur . $fh->readline;
            return $_;
        }

        return $_;
    }
}

our $MapDir;

my $map_classes = join '|', qw(type structure function);

sub map_files {
    my $self = shift;
    my $package = ref($self) || $self;

    my ($wanted) = $package =~ /($map_classes)/io;

    my (@dirs) = (($MapDir || './xs'), ModPerl::MapUtil::xs_glue_dirs());

    my @files;

    for my $dir (map { -d "$_/maps" ? "$_/maps" : $_ } @dirs) {
        opendir my $dh, $dir or warn "opendir $dir: $!";

        for (readdir $dh) {
            next unless /\.map$/;

            my $file = "$dir/$_";

            if ($wanted) {
                next unless $file =~ /$wanted/i;
            }

            #print "$package => $file\n";
            push @files, $file;
        }

        closedir $dh;
    }

    return @files;
}

sub parse_keywords {
    my ($self, $line) = @_;
    my %words;

    for my $pair (split /\s+/, $line) {
        my ($key, $val) = split /=/, $pair;

        unless ($key and $val) {
            die "parse error ($ModPerl::MapUtil::MapFile line $.)";
        }

        $words{$key} = $val;
    }

    %words;
}

sub parse_map_files {
    my ($self) = @_;

    my $map = {};

    for my $file (map_files($self)) {
        open my $fh, $file or die "open $file: $!";
        local $ModPerl::MapUtil::MapFile = $file;
        bless $fh, __PACKAGE__;
        @condition=();          # see readline() above
        $self->parse($fh, $map);
        close $fh;
    }

    return $map;
}

1;
__END__