File Coverage

lib/Devel/Required.pm

Criterion	Covered	Total	%
statement	65	73	89.0
branch	33	44	75.0
condition	4	4	100.0
subroutine	9	9	100.0
pod			n/a
total	111	130	85.3

package Devel::Required;

# set version information
$VERSION= '0.14';

# make sure we do everything by the book from now on
use strict;
use warnings;

# initializations
my @TEXT;         # list with text-file conversion
my @POD;          # list with pod-file conversion
my $INSTALLATION; # any installation information

# replace WriteMakefile with our own copy
BEGIN {
    no warnings 'redefine';
    no strict 'refs';
    my $subname= caller() . '::WriteMakefile';
    my $old= \&{$subname};
    *$subname= sub {

        # perform the old sub with parameters
        @_= @_; # quick fix for brokennes in 5.9.5, as suggested by rgs
        $old->( @_ );

        # initializations
        my $pod;       # pod filename to change
        my $modules;   # hash reference to the module info
        my $required;  # required text to replace
        my $version;   # version text to replace

        # each key and value pair passed to original WriteMakefile
        while (@_) {
            my ( $key, $value )= ( shift, shift );

            # main module file
            if ( $key eq 'VERSION_FROM' ) {
                $pod= $value;
            }

            # required modules hash ref
            elsif ($key eq 'PREREQ_PM') {
                $modules= $value;
            }

=for Explanation:
     Anything we don't handle is simply ignored.

=cut

        }

        # use E::M's logic to obtain version information
        ($version)= _slurp('Makefile') =~ m#\nVERSION = (\d+\.\d+)#s;

        # text to insert
        $required= join $/,
          map {" $_ (".($modules->{$_} || 'any').")"}
          sort {lc $a cmp lc $b}
           keys %{$modules}
             if $modules;
        $required ||= " (none)";

        # convert all text files that matter
        foreach ( grep { -s } @TEXT ? @TEXT : 'README' ) {
            _convert( $_, "Version:$/", " $version", "$/$/" )
              if $version;
            _convert( $_, "Required Modules:$/", $required, "$/$/" );
            _convert( $_, "Installation:$/", $INSTALLATION, "$/$/$/" )
              if $INSTALLATION;
        }

        # convert all pod files that matter
        foreach ( grep { -s } @POD ? @POD : ($pod ? ($pod) : () ) ) {
            _convert(
              $_,
              "=head1 VERSION$/",
              "$/This documentation describes version $version.$/",
              "$/="
            ) if $version;
            _convert( $_, "=head1 REQUIRED MODULES$/", "$/$required$/", "$/=" );
            _convert( $_, "=head1 INSTALLATION$/", "$/$INSTALLATION$/", "$/=")
              if $INSTALLATION;
        }
    };
} #BEGIN

# satisfy -require-
1;

#-------------------------------------------------------------------------------
#
# Standard Perl features
#
#-------------------------------------------------------------------------------
#  IN: 1 class (ignored)
#      2..N key/value pairs

sub import {

    # lose the class
    shift;

    # for all key value pairs
    while (@_) {
        my ( $type, $value )= ( shift, shift );

        # set up text file processing
        if ( $type eq 'text' ) {
            push @TEXT, ref $value ? @{$value} : ($value);
        }

        # set up pod file processing
        elsif ( $type eq 'pod' ) {
            push @POD,ref $value ? @{$value} : ($value);
        }

        # set up maint/blead installation information
        elsif ( $type eq 'maint_blead' ) {
            $INSTALLATION= <<"INSTALLATION";
This distribution contains two versions of the code: one maintenance version
for versions of perl < $value (known as 'maint'), and the version currently in
development (known as 'blead').  The standard build for your perl version is:

 perl Makefile.PL
 make
 make test
 make install

This will try to test and install the "blead" version of the code.  If the
Perl version does not support the "blead" version, then the running of the
Makefile.PL will *fail*.  In such a case, one can force the installing of
the "maint" version of the code by doing:

 perl Makefile.PL maint

Alternately, if you want automatic selection behavior, you can set the
AUTO_SELECT_MAINT_OR_BLEAD environment variable to a true value.  On Unix-like
systems like so:

 AUTO_SELECT_MAINT_OR_BLEAD=1 perl Makefile.PL

If your perl does not support the "blead" version of the code, then it will
automatically install the "maint" version of the code.

Please note that any additional parameters will simply be passed on to the
underlying Makefile.PL processing.
INSTALLATION
            chomp $INSTALLATION;
        }

        # huh?
        else {
            die qq{Don't know how to handle "$type"\n};
        }
    }
} #import

#-------------------------------------------------------------------------------
#
# Internal subroutines
#
#-------------------------------------------------------------------------------
# _convert
#
# Perform the indicated conversion on the specified file
#
#  IN: 1 filename
#      2 string before to match
#      3 string to insert between before and after
#      4 string to match with after

sub _convert {
    my ( $filename, $before, $text, $after )= @_;
    local $_;

=for Explanation:
     We want to make sure that this also runs on pre 5.6 perl's, so we're
     using old style open()

=cut

    # there is something to process
    if ( my $contents= $_= _slurp($filename) ) {

        # found and replaced text
        if ( s#$before(?:.*?)$after#$before$text$after#s ) {

            # same as before (no action)
            if ($_ eq $contents) {
            }

            # successfully saved file with changes
            elsif ( open( OUT, ">$filename" ) ) {
                print OUT $_;
                close OUT
                 or die qq{Problem flushing "$filename": $!\n};
                die qq{Did not properly install "$filename"\n}
                 unless -s $filename == length;
            }

            # could not save file
            else {
                warn qq{Could not open "$filename" for writing: $!\n};
            }
        }

        # couldn't replace
        else {
            $before =~ s#\s+$##s;
            warn qq{Could not find text marker "$before" in "$filename"\n};
        }
    }
} #_convert

#-------------------------------------------------------------------------------
# _slurp
#
# Return contents of given filename, a poor man's perl6 slurp().  Warns if
# it could not open the specified file
#
#  IN: 1 filename
# OUT: 1 file contents

sub _slurp {
    my ($filename)= @_;
    my $contents;

    # there is something to process
    if ( open( IN, $filename ) ) {
        $contents= do { local $/;  };
        close IN;
    }

    # couldn't read file
    else {
        warn qq{Could not open "$filename" for reading: $!\n};
    }

    return $contents;
} #_slurp

#-------------------------------------------------------------------------------

__END__