view release on metacpan or  search on metacpan

lib/Apache/TestConfig.pm  view on Meta::CPAN

    my @trys = grep { $_ }
      ($vars->{src_dir},
       $self->apxs('LIBEXECDIR'),
       catfile($sroot, 'modules'),
       catfile($sroot, 'libexec'));

    for (@trys) {
        my $file = catfile $_, $module;
        if (-e $file) {
            debug "found $module => $file";
            return $file;
        }
    }

    # if the module wasn't found try to lookup in the list of modules
    # inherited from the system-wide httpd.conf
    my $name = $module;
    $name =~ s/\.s[ol]$/.c/;  #mod_info.so => mod_info.c
    $name =~ s/^lib/mod_/; #libphp4.so => mod_php4.c
    return $self->{modules}->{$name} if $self->{modules}->{$name};

}

#generate files and directories

my %warn_style = (
    html    => sub { "<!-- @_ -->" },
    c       => sub { "/* @_ */" },
    php     => sub { "<?php /* \n@_ \n*/ ?>" },
    default => sub { join '', grep {s/^/\# /gm} @_ },
);

my %file_ext = (
    map({$_ => 'html'} qw(htm html)),
    map({$_ => 'c'   } qw(c h)),
    map({$_ => 'php' } qw(php)),
);

# return the passed file's extension or '' if there is no one
# note: that '/foo/bar.conf.in' returns an extension: 'conf.in';
# note: a hidden file .foo will be recognized as an extension 'foo'
sub filename_ext {
    my ($self, $filename) = @_;
    my $ext = (File::Basename::fileparse($filename, '\..*'))[2] || '';
    $ext =~ s/^\.(.*)/lc $1/e;
    $ext;
}

sub warn_style_sub_ref {
    my ($self, $filename) = @_;
    my $ext = $self->filename_ext($filename);
    return $warn_style{ $file_ext{$ext} || 'default' };
}

sub genwarning {
    my($self, $filename, $from_filename) = @_;
    return unless $filename;
    my $time = scalar localtime;
    my $warning = "WARNING: this file is generated";
    $warning .= " (from $from_filename)" if defined $from_filename;
    $warning .= ", do not edit\n";
    $warning .= "generated on $time\n";
    $warning .= calls_trace();
    return $self->warn_style_sub_ref($filename)->($warning);
}

sub calls_trace {
    my $frame = 1;
    my $trace = '';

    while (1) {
        my($package, $filename, $line) = caller($frame);
        last unless $filename;
        $trace .= sprintf "%02d: %s:%d\n", $frame, $filename, $line;
        $frame++;
    }

    return $trace;
}

sub clean_add_file {
    my($self, $file) = @_;

    $self->{clean}->{files}->{ rel2abs($file) } = 1;
}

sub clean_add_path {
    my($self, $path) = @_;

    $path = rel2abs($path);

    # remember which dirs were created and should be cleaned up
    while (1) {
        $self->{clean}->{dirs}->{$path} = 1;
        $path = dirname $path;
        last if -e $path;
    }
}

sub genfile_trace {
    my($self, $file, $from_file) = @_;
    my $name = abs2rel $file, $self->{vars}->{t_dir};
    my $msg = "generating $name";
    $msg .= " from $from_file" if defined $from_file;
    debug $msg;
}

sub genfile_warning {
    my($self, $file, $from_file, $fh) = @_;

    if (my $msg = $self->genwarning($file, $from_file)) {
        print $fh $msg, "\n";
    }
}

# $from_file == undef if there was no templates used
sub genfile {
    my($self, $file, $from_file, $nowarning) = @_;

    # create the parent dir if it doesn't exist yet
    my $dir = dirname $file;