Commits

Burak Gürsoy committed 68ab173

Use our prove.
Clean up

  • Participants
  • Parent commits 89fd7e4

Comments (0)

Files changed (2)

 use strict;
 use warnings;
 use utf8;
+
+use Carp qw(croak confess);
+use Cwd;
+use Data::Dumper;
 use Encode;
 use File::Copy;
 use File::Find;
 use File::HomeDir;
 use File::Spec::Functions qw( catfile catdir );
 use File::Temp qw( tempfile tempdir );
-use Cwd;
-use Carp qw(croak confess);
-use Data::Dumper;
 use Getopt::Long;
 use Time::HiRes qw( time );
 use Text::Template::Simple;
+
 use constant IS_WINDOWS         => $^O =~ m{ \A MSWin }xmsi;
 use constant BASE               => $ENV{BURAK_BUILD_BASE};
 use constant MAX_MODNAME_LENGTH => 3;
 
 BEGIN {
     *_print = sub { print @_ or croak "Unable to print to STDOUT: $!" }
-      if !defined &_print;
+        if ! defined &_print;
+
     *_error = sub { croak @_ }
-      if !defined &_error;
+        if ! defined &_error;
 }
 
 BEGIN { $| = 1; }
 END {
     my $eok = eval { require Time::Elapsed; 1; };
     my $t = $START_TIME ? time - $START_TIME : 0;
-    $@
-      ? _print( sprintf L('bench.error'), $t )
-      : _print( sprintf L('bench.ok'), Time::Elapsed::elapsed( $t, $LANG ) );
+    $@ ? _print( sprintf L('bench.error'), $t )
+       : _print( sprintf L('bench.ok'), Time::Elapsed::elapsed( $t, $LANG ) );
 }
 
 sub L {
 }
 
 sub run {
+
     system title => sprintf '%sv%s', __PACKAGE__, $VERSION if IS_WINDOWS;
+
     _print sprintf L('start.message'), __PACKAGE__, $VERSION;
     my $eok = eval { hello(); 1; };
 
 }
 
 sub finish {
-    _chdir( $path{cwd} ) if $path{cwd};    # return home to delete tempdir()
+    _chdir( $path{cwd} ) if $path{cwd}; # return home to delete tempdir()
     _print tts(
         L('finish.report'),
         [
         builder => catfile( BASE, qw( CPAN tools builder ) ),
     );
 
-    -e $p{source}  or _error tts( L('get_path.source'),  [ source  => $p{source}  ] );
-    -e $p{build}   or _error tts( L('get_path.build'),   [ build   => $p{build}   ] );
-    -e $p{archive} or _error tts( L('get_path.archive'), [ archive => $p{archive} ] );
+    if ( ! -e $p{source} ) {
+        _error tts( L('get_path.source'),  [ source  => $p{source}  ] );
+    }
+
+    if ( ! -e $p{build} ) {
+        _error tts( L('get_path.build'),   [ build   => $p{build}   ] );
+    }
+
+    if ( ! -e $p{archive} ) {
+        _error tts( L('get_path.archive'), [ archive => $p{archive} ] );
+    }
+
     return %p;
 }
 
     my ( @dir, @file );
     find {
         wanted => sub {
-            #(my $path = $File::Find::name) =~ s*$source_dir**;
-            #$path =~ s,^[\\/],,;
-            return if !$_;
-            return if $_ =~ m{ \A [.]/[.] }xms;
+            return if ! $_ || $_ =~ m{ \A [.]/[.] }xms;
             -d $_ ? push @dir, catdir($_) : push @file, catfile($_);
         },
         no_chdir => 1,
         _chdir( catdir $path{builder} );
         find {
             wanted => sub {
-                return if !$_;
-                #return if $_ =~ m{ \A [.]/[.] }xms;
-                return if $_ eq q{.};
+                return if ! $_ || $_ eq q{.};
                 ( my $bare = catfile $_);
                 $bare =~ s{ \A [\\/]+    }{}xms;
                 $bare =~ s{    [\\/]+ \z }{}xms;
-                -d $_ ? do { push @dir, $bare if $bare } : push @bfile, catfile($_);
+                -d $_ ? do { push @dir, $bare if $bare }
+                      : push @bfile, catfile($_);
             },
             no_chdir => 1,
         }, q{.};
     mkpath \@dir;
 
     foreach my $file (@file) {
-        copy( catfile( $path{source}, $target, $file ), $file )
-          or _error tts( L('duplicate.copy'), [ file => $file, error => $! ] );
+        next if copy( catfile( $path{source}, $target, $file ), $file );
+        _error tts( L('duplicate.copy'), [ file => $file, error => $! ] );
     }
 
     if ( ! $ALIEN ) {
     my @modlist;
     opendir my $MODDIR, $path{source}
       or _error "$path{source} dizini okunamıyor: $!";
+
     while ( my $file = readdir $MODDIR ) {
         next if $file =~ m{ \A [._] }xms;
         next if !-d catdir( $path{source}, $file );
     }
     closedir $MODDIR;
 
-    _error L('ask.nomodules') if not @modlist;
+    _error L('ask.nomodules') if ! @modlist;
 
     @modlist = sort { lc $a cmp lc $b } @modlist;
 
     _print L('ask.found');
-    for my $i ( 0 .. $#modlist ) {
+    foreach my $i ( 0 .. $#modlist ) {
         printf "   [% 2s] %s\n", $i + 1, $modlist[$i];
     }
 
             redo ASK;
         }
 
-
         if ( ! exists $modlist[ $targetx - 1 ] ) {
             _print( L('error.notexists') );
             redo ASK;
 sub write_file {
     my($mode, $file, @data) = @_;
     $mode = $mode . ':raw';
-    open my $FH, $mode, $file or _error tts( L('write_file.error'), [ file => $file, error => $! ] );
+    open my $FH, $mode, $file
+        or _error tts( L('write_file.error'), [ file => $file, error => $! ] );
     print {$FH} @data or _error "Unable to print to FH: $!";
     close $FH or _error "Unable to close FH: $!";
     return;
 
 sub unix {
     my $f = shift or _error L('unix.nofile');
-    open my $ORIGINAL, '<:raw', $f          or _error tts( L('unix.eread'),  [ file => $f, error => $! ] );
-    open my $NEWFILE,  '>:raw', $f . '.foo' or _error tts( L('unix.ewrite'), [ file => $f, error => $! ] );
+
+    open my $ORIGINAL, '<:raw', $f
+        or _error tts( L('unix.eread'),  [ file => $f, error => $! ] );
+    open my $NEWFILE,  '>:raw', $f . '.foo'
+        or _error tts( L('unix.ewrite'), [ file => $f, error => $! ] );
+
     while (<$ORIGINAL>) {
         s/\r\n/\n/xms;
         print {$NEWFILE} $_ or _error "Unable to print to FH: $!";;
     }
+
     close $ORIGINAL or _error "Unable to close FH: $!";
     close $NEWFILE  or _error "Unable to close FH: $!";
+
     unlink $f;
     rename $f . '.foo', $f;
+
     return;
 }
 
         'exit.message'    => "\n\n\tSession terminated!\n\n",
         'error.notnumber' => "\n\tInput is not a number!\n\n",
         'error.length'    => "\n\tInput is too big!\n\n",
-        'error.notexists' => "\n\tYou want to select something that does not exist!\n\n",
+        'error.notexists' => "\n\tYou wanted to select something that does not exist!\n\n",
         'ask.selection'   => 'Select a module to build [1]: ',
         'finish.report'   => <<'INFO',
 Directories used in this session:

builder/builder/Build.pm

    PROVE: {
       warn "\tTESTING MONOLITH\n";
       local $ENV{AUTHOR_TESTING_MONOLITH_BUILD} = 1;
-      my @output = qx(prove -Imonolithic_version);
+      require File::Basename;
+      require File::Spec;
+      my $pbase = File::Basename::dirname( $^X );
+
+      my $prove;
+      find {
+         wanted => sub {
+            my $file = $_;
+            return if $file !~ m{ prove }xms;
+            $prove = $file;
+         },
+         no_chdir => 1,
+      }, $pbase;
+
+      if ( ! $prove || ! -e $prove ) {
+          croak "No `prove command found related to $^X`";
+      }
+
+      warn "\n\tFOUND `prove` at $prove\n\n";
+
+      my @output = qx($prove -Imonolithic_version);
       for my $line ( @output ) {
          print "\t$line" or croak "Unable to print to STDOUT: $!";
       }