Burak Gürsoy avatar Burak Gürsoy committed 4609943

Use a simple templating mechanism.
Clean up.

Comments (0)

Files changed (9)

builder/builder/Build.pm

     print "\t" or croak "Unable to print to STDOUT: $!";
     system( $^X, '-wc', $mono ) && die "$mono does not compile!\n";
 
-    $self->_monolith_prove();
+    $self->_monolith_prove;
 
     warn "\tADD README\n";
     $self->_write_file('>', $readme, $self->_monolith_readme);
     }
     chomp(my $result = pop @output);
     croak MONOLITH_TEST_FAIL if $result ne 'Result: PASS';
+
     return;
 }
 
     close $TOP or croak 'Can not close BUFFER file';
 
     open my $COPY, '<:raw', $copy or croak "Can not open file($copy): $!";
+
     while ( defined( my $line = <$COPY> ) ) {
         print {$W} $line or croak "Can not print to COPY file: $!";
     }
 
-    close $COPY or croak "Can not close COPY file: $!";
-    close $W    or croak "Can not close MONO file: $!";
+    close $COPY or croak "Can't close COPY file: $!";
+    close $W    or croak "Can't close MONO file: $!";
 
     return;
 }
     my($self, $mode, $file, @data) = @_;
     $mode = $mode . ':raw';
     open my $FH, $mode, $file or croak "Can not open file($file): $!";
-    foreach my $content ( @data ) {
-        print {$FH} $content or croak "Can not print to FH: $!";
-    }
+    print {$FH} @data or croak "Can not print to FH: $!";
     close $FH or croak "Can not close $file $!";
     return;
 }
     my $base = shift;
     my $list = $self->monolith_add_to_top || croak 'monolith_add_to_top not set';
     croak 'monolith_add_to_top is not an ARRAY' if ref $list ne 'ARRAY';
-    foreach my $test ( @{ $list } ) {
-        return 1 if $test eq $base;
-    }
-    return 0;
+    return grep { $_ eq $base } @{ $list };
 }
 
 sub _monolith_readme {
     my $self = shift;
-    my $pod  = $self->_monolith_pod_warning;
-    $pod =~ s{B<(.+?)>}{$1}xmsg;
+    (my $pod  = $self->_monolith_pod_warning) =~ s{B<(.+?)>}{$1}xmsg;
     return $pod;
 }
 
 sub _monolith_pod_warning {
     my $self = shift;
-    my $name = $self->module_name;
-    return <<"MONOLITH_POD_WARNING";
-
-B<WARNING>! This is the monolithic version of $name
-generated with an automatic build tool. If you experience problems
-with this version, please install and use the supported standard
-version. This version is B<NOT SUPPORTED>.
-MONOLITH_POD_WARNING
+    return $self->_compile_template(
+                'pod/monolith-warning.pod' => {
+                    module => $self->module_name,
+                },
+            );
 }
 
 sub _automatic_build_file_header {
-    my $self = shift;
-    return <<'HEAD';
-#!/usr/bin/env perl
-# This file was created automatically
-use 5.006;
-use strict;
-use warnings;
-use lib qw( builder );
-
-HEAD
+    return shift->_compile_template( 'tools/builder.header' );
 }
 
 sub _add_automatic_build_pl {
 }
 
 sub _automatic_build_pl {
-    my $self  = shift;
-    my %spec  = Build::Spec::spec( builder => 1 );
-    my $build = delete $spec{BUILDER} || croak 'SPEC does not have a BUILDER key';
-    my @opt;
-    foreach my $k ( keys %{ $build } ) {
-        push @opt, sprintf q{$mb->%s( %s )}, $k, $build->{ $k };
-    }
-    return $self->_automatic_build_file_header
-         . sprintf <<'BUILD_PL', join ";\n", @opt;
-use Build;
-my $mb = Build->new;
-%s;
-$mb->create_build_script;
+    my $self    = shift;
+    my %spec    = Build::Spec::spec( builder => 1 );
+    my $build   = delete $spec{BUILDER} || croak 'SPEC does not have a BUILDER key';
+    my $methods = join ";\n",
+                  map { sprintf q{$mb->%s( %s )}, $_, $build->{ $_ } }
+                  keys %{ $build };
 
-1;
-
-BUILD_PL
+    return join q{},
+                $self->_automatic_build_file_header,
+                $self->_compile_template(
+                    'tools/Build.PL' => {
+                        methods => $methods,
+                    },
+                ),
+            ;
 }
 
 sub _add_vanilla_makefile_pl {
     my $self = shift;
     my $file = 'Makefile.PL';
-    return if -e $file; # do not overwrite
+    return if -e $file; # don't overwrite
     $self->_write_file(  '>', $file    => $self->_vanilla_makefile_pl       );
     $self->_write_file( '>>', MANIFEST => "$file\tGenerated automatically\n");
     warn "ADDED VANILLA $file\n";
 sub _vanilla_makefile_pl {
     my $self = shift;
     my $hook = $self->initialization_hook;
-    my $extra = ! $hook ? q() : <<'HOOK';
-
-my $eok = eval <<'THIS_IS_SOME_IDENTIFIER';
-<%HOOK%>
-THIS_IS_SOME_IDENTIFIER
-
-die "Error compiling initialization_hook: $@\n" if $@;
-
-HOOK
-
-    $extra =~ s{<%HOOK%>}{$hook}xmsg if $extra;
-
-    my $code = $self->_automatic_build_file_header;
-    $code .= <<'VANILLA_MAKEFILE_PL';
-use Build::Spec qw( mm_spec );
-use ExtUtils::MakeMaker;
-
-my %spec = mm_spec;
-<%EXTRA%>
-WriteMakefile(
-    NAME         => $spec{module_name},
-    VERSION_FROM => $spec{VERSION_FROM},
-    PREREQ_PM    => $spec{PREREQ_PM},
-    PL_FILES     => {},
-    ($] >= 5.005 ? (
-    AUTHOR       => $spec{dist_author},
-    ABSTRACT     => $spec{ABSTRACT},
-    EXE_FILES    => $spec{EXE_FILES},
-    ) : ()),
-);
-VANILLA_MAKEFILE_PL
-    $code =~ s{<%EXTRA%>}{$extra}xmsg;
-    return $code;
+    return join q{},
+                $self->_automatic_build_file_header,
+                $self->_compile_template(
+                    'tools/Makefile.PL' => {
+                        hook     => $hook,
+                        has_hook => $hook ? 1 : 0,
+                    },
+                ),
+            ;
 }
 
 sub _pod_author_copyright_license {
     my $self = shift;
     my $da   = $self->dist_author; # support only 1 author for now
-    my($author, $email) = $da->[0] =~ m{ (.+?) < ( .+?) > }xms;
-    $author = trim( $author );
-    $email  = trim( $email );
-    my $cfy = $self->copyright_first_year;
+    my $cfy  = $self->copyright_first_year;
     my $year = (localtime time)[YEAR_SLOT] + YEAR_ADD;
-    $year = "$cfy - $year" if $cfy && $cfy != $year && $cfy < $year;
-    my $perl = sprintf '%vd', $^V;
-    return <<"POD";
-=head1 AUTHOR
+    my($author, $email) = $da->[0] =~ m{ (.+?) < (.+?) > }xms;
+    $author = trim( $author ) if $author;
+    $email  = trim( $email )  if $email;
+    $year   = "$cfy - $year"  if $cfy && $cfy != $year && $cfy < $year;
 
-$author <$email>.
+    return $self->_compile_template(
+                'pod/author.pod' => {
+                    author => $author,
+                    email  => $email,
+                    year   => $year,
+                    perl   => sprintf( '%vd', $^V ),
+                },
+            );
 
-=head1 COPYRIGHT
+}
 
-Copyright $year $author. All rights reserved.
+sub _compile_template {
+    my($self, $path, $param) = @_;
 
-=head1 LICENSE
+    my $full_path = File::Spec->catfile(  qw( builder templates ), $path );
+    die "Can't locate template $path: $!" if ! -e $full_path;
 
-This library is free software; you can redistribute it and/or modify 
-it under the same terms as Perl itself, either Perl version $perl or, 
-at your option, any later version of Perl 5 you may have available.
+    $param ||= {};
+    my $raw = slurp( $full_path );
+    my %p   = map { uc( $_ ) => $param->{ $_ } } keys %{ $param };
+    my %seen;
+    my $key_value = sub {
+        my $match = shift;
+        my $key   = trim( $match );
+        my $value = $p{ $key };
 
-POD
+        if ( ! defined $value ) {
+            if ( ! $seen{ $key }++ ) {
+                warn "$path: Bogus or no value for template key '$key'";
+            }
+            return q();
+        }
+
+        return $value;
+    };
+
+    $raw =~ s{[[][%](.+?)[%][]]}{$key_value->($1)}xmsge;
+
+    return $raw;
 }
 
 1;

builder/builder/Build/Util.pm

     }
     open my $FH, '<', $path  or Carp::croak( "Can not open file($path): $!" );
     my $rv = do { local $/; <$FH> };
-    close { $FH } || Carp::croak( "Can't close($path): $!" );
+    close $FH or Carp::croak( "Can't close($path): $!" );
     return $rv;
 }
 

builder/builder/templates/pod/author.pod

+=head1 AUTHOR
+
+[%AUTHOR%] <[%EMAIL%]>.
+
+=head1 COPYRIGHT
+
+Copyright [%YEAR%] [%AUTHOR%]. All rights reserved.
+
+=head1 LICENSE
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version [%PERL%] or,
+at your option, any later version of Perl 5 you may have available.

builder/builder/templates/pod/monolith-warning.pod

+
+B<WARNING>! This is the monolithic version of [%MODULE%]
+generated with an automatic build tool. If you experience problems
+with this version, please install and use the supported standard
+version. This version is B<NOT SUPPORTED>.

builder/builder/templates/tools/Build.PL

+use Build;
+my $mb = Build->new;
+
+[%METHODS%];
+
+$mb->create_build_script;
+
+1;

builder/builder/templates/tools/Makefile.PL

+use Build::Spec qw( mm_spec );
+use ExtUtils::MakeMaker;
+
+my %spec = mm_spec;
+
+if ([%HAS_HOOK%]) {
+    my $eok = eval <<'THIS_IS_SOME_IDENTIFIER';
+[%HOOK%]
+THIS_IS_SOME_IDENTIFIER
+
+    die "Error compiling initialization_hook: $@\n" if $@;
+}
+
+WriteMakefile(
+    NAME         => $spec{module_name},
+    VERSION_FROM => $spec{VERSION_FROM},
+    PREREQ_PM    => $spec{PREREQ_PM},
+    PL_FILES     => {},
+    ($] >= 5.005 ? (
+    AUTHOR       => $spec{dist_author},
+    ABSTRACT     => $spec{ABSTRACT},
+    EXE_FILES    => $spec{EXE_FILES},
+    ) : ()),
+);

builder/builder/templates/tools/builder.header

+#!/usr/bin/env perl
+# This file was created automatically
+use 5.006;
+use strict;
+use warnings;
+use lib qw( builder );

builder/xt/author/201-pod.t

 #!/usr/bin/env perl -w
 use strict;
 use warnings;
+
+use constant NEW_PERL => 5.008;
+use constant MIN_TPV  => 1.26;
+use constant MIN_PSV  => 3.05;
+
 use Test::More;
-use constant NEW_PERL => 5.008;
-use constant MIN_TPV => 1.26;
-use constant MIN_PSV => 3.05;
 
-my(@errors, $eok);
-$eok = eval { require Test::Pod;   1; };
-push @errors, 'Test::Pod is required for testing POD'   if $@ || ! $eok;
-$eok = eval { require Pod::Simple; 1; };
-push @errors, 'Pod::Simple is required for testing POD' if $@ || ! $eok;
+my @errors;
 
-if ( not @errors ) {
-   my $tpv = Test::Pod->VERSION;
-   my $psv = Pod::Simple->VERSION;
+eval {
+    require Test::Pod;
+    require Pod::Simple;
 
-   if ( $tpv < MIN_TPV ) {
-      push @errors, 'Upgrade Test::Pod to 1.26 to run this test. '
-                   ."Detected version is: $tpv";
-   }
+    my $tpv = Test::Pod->VERSION;
+    my $psv = Pod::Simple->VERSION;
 
-   if ( $psv < MIN_PSV ) {
-      push @errors, 'Upgrade Pod::Simple to 3.05 to run this test. '
-                   ."Detected version is: $psv";
-   }
+    if ( $tpv < MIN_TPV ) {
+        push @errors, "Test::Pod >= 1.26 (you have $tpv) is needed for this test.";
+    }
+
+    if ( $psv < MIN_PSV ) {
+        push @errors, "Pod::Simple >= 3.05 (you have $psv) is needed for this test.";
+    }
+
+    1;
+} or do {
+    push @errors, 'Test::Pod & Pod::Simple are required for testing POD';
+};
+
+if ( $] < NEW_PERL ) {
+   # Legacy perl does not have Encode.pm. Thus, Pod::Simple
+   # can not handle utf8 encoding and it will die, the tests
+   # will fail.
+   push @errors, q{"=encoding utf8" directives in Pods don't work with legacy perl.};
 }
 
-if ( $] < NEW_PERL ) {
-   # Any older perl does not have Encode.pm. Thus, Pod::Simple
-   # can not handle utf8 encoding and it will die, the tests
-   # will fail. This skip part, skips an inevitable failure.
-   push @errors, '"=encoding utf8" directives in Pods don\'t work '
-                .'with legacy perl.';
-}
-
-if ( @errors ) {
-   plan skip_all => "Errors detected: @errors";
-}
-else {
-   Test::Pod::all_pod_files_ok();
-}
+@errors ? plan( skip_all => "Errors detected: @errors" )
+        : Test::Pod::all_pod_files_ok()
+        ;

builder/xt/author/202-pod-coverage.t

 
 # build tool runs the whole test suite on the monolithic version.
 # Don't bother testing it if exists
-plan skip_all => 'Skipping for monolith build test' if $ENV{AUTHOR_TESTING_MONOLITH_BUILD};
-
-my $eok = eval 'use Test::Pod::Coverage;1;';
-my $e   = $@ || ! $eok;
+if ( $ENV{AUTHOR_TESTING_MONOLITH_BUILD} ) {
+    plan( skip_all => 'Skipping for monolith build test' );
+}
 
 eval {
-    $e ? plan( skip_all => 'Test::Pod::Coverage required for testing pod coverage' )
-       : all_pod_coverage_ok();
+    require Test::Pod::Coverage;
+    1;
+} or do {
+    diag("Error loading Test::Pod::Coverage: $@");
+    plan( skip_all => 'Test::Pod::Coverage required for testing pod coverage' );
+    exit;
+};
+
+eval {
+    Test::Pod::Coverage::all_pod_coverage_ok();
     1;
 } or do {
     diag( "Some error happened in somewhere, which I don't care: $@" );
     ok( 1, 'Fake test' );
-}
+};
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.