File Coverage

blib/lib/ExtUtils/ModuleMaker/TT.pm

Criterion	Covered	Total	%
statement	84	97	86.6
branch	16	28	57.1
condition	2	3	66.6
subroutine	17	21	80.9
pod	4	16	25.0
total	123	165	74.5

use strict;
use warnings;

package ExtUtils::ModuleMaker::TT;
# ABSTRACT: Makes skeleton modules with Template Toolkit templates (UNMAINTAINED)
our $VERSION = '0.94'; # VERSION

use Path::Class 0.15;
use Template 2.14;

# predeclare
our %templates;

sub _get_dir_and_file {
    my $module = shift;
    my @layers      = split( /::/, $module->{NAME} );
    my $file        = pop(@layers) . '.pm';
    my $dir         = join( '/', 'lib', @layers );
    return ($dir, $file);
}

sub build_single_pm {
    my ($self, $module) = @_;
    my $module_object;

    if ( ref($module) ) {
        if ( $module == $self) {
            $module_object = $module;
        } else {
            $module_object = { %{$self}, %{$module} };
        }
    } else {
        $module_object = { %{$self}, NAME => $module };
    }

    # To support calling this function on a standalone basis, look upwards
    # for a base directory
    # (abs->rel) is a workaround to drop the volume on MSWin32
    my $orig_wd = my $cwd = dir()->absolute;
    my $root_dir = dir(q{})->absolute;
    unless ($self->{Base_Dir}) {
        while (! $cwd->subsumes($root_dir)) {
            chdir $cwd;
            if ( -e 'MANIFEST' and -d 'lib' ) {
                $self->{Base_Dir} = $cwd;
                last;
            }
            $cwd = $cwd->parent;
        }
        chdir $orig_wd;
        $self->death_message(["Can't locate base directory"])
            unless $self->{Base_Dir};
    }

    my ( $dir, $file ) = _get_dir_and_file( $module_object );
    $self->create_directory( dir($self->{Base_Dir}, $dir ));

    $module_object->{new_method} = $self->build_single_method('new');
    # hack to remove subroutine bit    -- a real new sub is in module.pm template
     $module_object->{new_method} =~ s/sub new {.*}\n//s;
    # hack to add class name to call new in example
     $module_object->{new_method} =~ s/\$rv = /\$rv = $module_object->{NAME}->/s;

    $self->print_file(
        file( $dir, $file ),
        $self->text_pm_file( $module_object )
    );

    (my $clean_name = $module_object->{NAME} ) =~ s/::/_/g;
    my $testfile = file( "t", $clean_name . ".t" );
    $self->print_file(
        $testfile,
        $self->text_test( $clean_name, $module_object )
    );

    chdir $orig_wd;
    return 1;
}

sub build_single_method {
    my ($self,$method_name) = @_;
    my $results;

    my $tt = ( $self->{'TEMPLATE_DIR'} ?
        Template->new({'INCLUDE_PATH' => $self->{'TEMPLATE_DIR'} }) :
        Template->new() )
        or $self->death_message([ "Template error: $Template::ERROR" ]);
    my $template_text = $templates{'method'};
    $tt->process( $self->{'TEMPLATE_DIR'} ? 'method' : \$template_text,
                  { %{ $self }, method_name => $method_name }, \$results )
        or $self->death_message([ "Could not write method '$method_name': "
            . $tt->error()  ]);
    return $results;
}


#--------------------------------------------------------------------------#
# subclassing ExtUtils::ModuleMaker::StandardText
#--------------------------------------------------------------------------#


sub text_README {
    my $self = shift;
    return $self->process_template( 'README', $self );
}

sub text_Todo {
    my $self = shift;
    return $self->process_template( 'Todo', $self );
}

sub text_Changes {
    my $self = shift;
    return $self->process_template( 'Changes', $self );
}

sub text_test {
    my ( $self, $test_filename, $module_data ) = @_;
    return $self->process_template( 'test.t', $module_data );
}

sub text_test_multi {
    my ( $self, $testfilename, $pmfilesref ) = @_;
    my @pmfiles = @{$pmfilesref};
    return $self->process_template( 'test.t', $self );
}

sub text_Makefile {
    my $self = shift;
    return $self->process_template( 'Makefile.PL', $self );
}


sub text_Buildfile {
    my $self = shift;
    return $self->process_template( 'Build.PL', $self );
}

sub text_proxy_makefile {
    my $self = shift;
    return $self->process_template( 'Proxy_Makefile.PL', $self );
}

sub text_MANIFEST_SKIP {
    my $self = shift;
    return $self->process_template( 'MANIFEST.SKIP', $self );
}

sub text_pod_coverage_test {
    my $self = shift;
    return $self->process_template( 'pod_coverage.t', $self );
}

sub text_pod_test {
    my $self = shift;
    return $self->process_template( 'pod.t', $self );
}

sub text_pm_file {
    my $self = shift;
    my $module_data = shift;

    return $self->process_template( 'module.pm', $module_data );
}

#--------------------------------------------------------------------------#
# Template handling
#--------------------------------------------------------------------------#

sub create_template_directory {
    my ($class, $dir) = @_;
    dir($dir)->mkpath;
    for my $template ( keys %templates ) {
        my $target = dir($dir, $template);
        open (FILE, ">", $target) or croak ("Could not write '$target', $!");
        print FILE ( $templates{$template} );
        close FILE;
    }
    return 1;
}

sub process_template {
    my ($self, $template, $data) = @_;
    my $tt = ( $self->{'TEMPLATE_DIR'} ?
        Template->new({'INCLUDE_PATH' => $self->{'TEMPLATE_DIR'} }) :
        Template->new() )
        or $self->death_message([ "Template error: $Template::ERROR" ]);
    my $template_text = $templates{$template};
    my $output_text;
    $tt->process( $self->{'TEMPLATE_DIR'} ? $template : \$template_text,
                  $data, \$output_text )
        or $self->death_message([
            "Could not generate $template contents: " . $tt->error()
        ]);
    return $output_text;
}

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

    $templates{'README'} = <<'EOF';
If this is still here it means the programmer was too lazy to create the readme file.

You can create it now by using the command shown below from this directory:

pod2text [%  NAME %] > README

At the very least you should be able to use this set of instructions
to install the module...

[%- IF BUILD_SYSTEM == 'ExtUtils::MakeMaker' -%]
perl Makefile.PL
make
make test
make install
[%- ELSE -%]
perl Build.PL
perl Build
perl Build test
perl Build install
[%- END -%]

If you are on a windows box you should use 'nmake' rather than 'make'.
EOF

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

    $templates{'Changes'} = <<'EOF';
Revision history for Perl module [%  NAME %]

[%  VERSION %] [% timestamp %]
    - original skeleton created with ExtUtils::ModuleMaker::TT
EOF

    $templates{'Todo'} = <<'EOF';
TODO list for Perl module [%  NAME %]

- Nothing yet

EOF

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

    $templates{'Build.PL'} = <<'EOF';
use Module::Build;
# See perldoc Module::Build for details of how this works

Module::Build->new(
    module_name         => '[%  NAME %]',
    dist_author         => '[%  AUTHOR %] <[% EMAIL %]>',
[%- IF LICENSE.match('perl|gpl|artistic') %]
    license             => '[%  LICENSE %]',
[%- END %]
    create_readme       => 1,
    create_makefile_pl  => 'traditional',
    requires        => {
        # module requirements here
    },
    build_requires  => {
        Test::Simple => 0.44,
    },
)->create_build_script;
EOF

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

    $templates{'Makefile.PL'} = <<'EOF';
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
    NAME         => '[%  NAME %]',
    VERSION_FROM => '[%  FILE %]', # finds $VERSION
    AUTHOR       => '[%  AUTHOR %] ([%  EMAIL %])',
    ABSTRACT     => '[% ABSTRACT %]',
    PREREQ_PM    => {
                     'Test::Simple' => 0.44,
                    },
);
EOF

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

    $templates{'Proxy_Makefile.PL'} = <<'EOF';
unless (eval "use Module::Build::Compat 0.02; 1" ) {
  print "This module requires Module::Build to install itself.\n";

  require ExtUtils::MakeMaker;
  my $yn = ExtUtils::MakeMaker::prompt
    ('  Install Module::Build from CPAN?', 'y');

  if ($yn =~ /^y/i) {
    require Cwd;
    require File::Spec;
    require CPAN;

    # Save this 'cause CPAN will chdir all over the place.
    my $cwd = Cwd::cwd();
    my $makefile = File::Spec->rel2abs($0);

    CPAN::Shell->install('Module::Build::Compat');

    chdir $cwd or die "Cannot chdir() back to $cwd: $!";
    exec $^X, $makefile, @ARGV;  # Redo now that we have Module::Build
  } else {
    warn " *** Cannot install without Module::Build.  Exiting ...\n";
    exit 1;
  }
}
Module::Build::Compat->run_build_pl(args => \@ARGV);
Module::Build::Compat->write_makefile();

EOF

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

    $templates{'MANIFEST.SKIP'} = <<'EOF';
# Version control files and dirs.
\bRCS\b
\bCVS\b
,v$
.svn/

# ExtUtils::MakeMaker generated files and dirs.
^MANIFEST\.(?!SKIP)
^Makefile$
^blib/
^blibdirs$
^PM_to_blib$
^MakeMaker-\d

# Module::Build
^Build$
^_build

# Temp, old, vi and emacs files.
~$
\.old$
^#.*#$
^\.#
\.swp$
\.bak$
EOF

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

    $templates{'test.t'} = <<'EOF';
# [%  NAME %] - check module loading and create testing directory

use Test::More tests => [% IF NEED_NEW_METHOD %] 2 [% ELSE %] 1 [% END %];

BEGIN { use_ok( '[%  NAME %]' ); }
[% IF NEED_NEW_METHOD %]
my $object = [%  NAME %]->new ();
isa_ok ($object, '[%  NAME %]');
[%- END %]
EOF

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

    $templates{'module.pm'} = <<'EOF';
package [%  NAME %];
use strict;
use warnings;
use Carp;

BEGIN {
    use Exporter ();
    use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
    $VERSION     = "0.92";
    @ISA         = qw (Exporter);
    @EXPORT      = qw ();
    @EXPORT_OK   = qw ();
    %EXPORT_TAGS = ();
}

[%- IF NEED_POD %]
#--------------------------------------------------------------------------#
# main pod documentation
#--------------------------------------------------------------------------#

# Below is the stub of documentation for your module. You better edit it!

!=head1 NAME

[%  NAME %] - Put abstract here

!=head1 SYNOPSIS

 use [%  NAME %];
 blah blah blah

!=head1 DESCRIPTION

Description...

!=head1 USAGE

Usage...

!=cut

[% END %]
[%- IF NEED_NEW_METHOD -%]
[% new_method -%]
sub new {
    my ($class, $parameters) = @_;

    croak "new() can't be invoked on an object"
        if ref($class);

    my $self = bless ({ }, $class);
    return $self;
}
[% END %]
1; #this line is important and will help the module return a true value
__END__