BuildStem.pm

   1 package BuildStem;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Config;
   7 use File::Basename;
   8 use File::Spec;
   9 use IO::File;
  10
  11 use Module::Build;
  12
  13 use vars qw(@ISA);
  14 @ISA = qw(Module::Build);
  15
  16
  17 sub process_script_files {
  18         my ( $self ) = @_ ;
  19         my $files = $self->find_script_files();
  20         return unless keys %$files;
  21
  22         my $script_dir = File::Spec->catdir($self->blib, 'script');
  23         my $demo_dir   = File::Spec->catdir($self->blib, 'demo');
  24         File::Path::mkpath( $script_dir );
  25         File::Path::mkpath( $demo_dir );
  26     $self->add_to_cleanup($demo_dir);
  27
  28         foreach my $file (keys %$files) {
  29                 my $dest_dir = $file =~ /_demo$/ ? $demo_dir : $script_dir ;
  30                 my $result = $self->copy_if_modified($file, $dest_dir, 'flatten') or next;
  31                 $self->fix_shebang_line($result) if $self->is_unixish();
  32                 $self->make_executable($result);
  33         my $demo_run_dir = File::Spec->catdir($self->base_dir(), 'demo');
  34                 if ( $result =~ /(?:run_stem$)|(?:_demo$)/ ) {
  35                         my $result2 = $self->copy_if_modified($result, $demo_run_dir, 'flatten') or next;
  36                         $self->add_to_cleanup($result2);
  37                 }
  38         }
  39         return 1;
  40 }
  41
  42 sub process_conf_files {
  43         my ( $self ) = @_ ;
  44         my $files = $self->_find_file_by_type('stem','conf');
  45         return unless keys %$files;
  46
  47         my $conf_dir = File::Spec->catdir($self->blib, 'conf');
  48         File::Path::mkpath( $conf_dir );
  49
  50
  51         foreach my $file (keys %$files) {
  52                 my $result = $self->copy_if_modified($file, $conf_dir, 'flatten') or next;
  53                 $self->fix_shebang_line($result) if $self->is_unixish();
  54         }
  55         return 1;
  56 }
  57
  58 sub find_binary {
  59         my ( $self, $prog ) = @_ ;
  60         if ( $self->do_system( "which $prog >/dev/null" ) ) {
  61                 return `which $prog` ;
  62         }
  63         return;
  64 }
  65
  66
  67 ###########################################################
  68 # Various convenience routines.
  69 #
  70 # To use ACTION_foo, call ./Build foo
  71
  72
  73
  74 # ACTION: grep through MANIFEST
  75 # command line args:
  76 #   files=<regex>
  77 #
  78 # do we need this action?
  79 #
  80
  81 sub ACTION_grep_manifest {
  82
  83     my( $self ) = @_ ;
  84
  85     my @manifest_sublist = $self->grep_manifest() ;
  86
  87     print join( "\n", @manifest_sublist ), "\n" ;
  88     return;
  89 }
  90
  91
  92
  93 # grep through all matched files
  94 # command line args:
  95 #   files=<regex> (default is all .pm files)
  96 #   re=<regex>
  97
  98 sub ACTION_grep {
  99
 100     my( $self ) = @_ ;
 101
 102     my $args = $self->{'args'} ;
 103
 104     my $file_regex = $args->{ files } || qr/\.pm$/ ;
 105     my $grep_regex = $args->{ re } or die "need grep regex" ;
 106
 107     my @manifest_sublist = $self->grep_manifest( $file_regex ) ;
 108
 109     local( @ARGV ) = @manifest_sublist ;
 110
 111     while( <> ) {
 112
 113         next unless /$grep_regex/ ;
 114
 115         print "$ARGV:$. $_"
 116     }
 117     continue {
 118
 119         close ARGV if eof ;
 120     }
 121
 122     return;
 123 }
 124
 125 my ( @manifest_lines ) ;
 126
 127 # MANIFEST helper subs
 128
 129 sub grep_manifest {
 130
 131     my( $self, $file_regex ) = @_ ;
 132
 133     $file_regex ||= $self->{ args }{ files } || qr/.*/ ;
 134
 135     manifest_load() ;
 136
 137     return grep( /$file_regex/, @manifest_lines ) ;
 138 }
 139
 140 sub manifest_load {
 141
 142     return if @manifest_lines ;
 143
 144     @manifest_lines = grep ! /^\s*$|^\s*#/, read_file( 'MANIFEST' ) ;
 145
 146     chomp @manifest_lines ;
 147
 148     return ;
 149 }
 150
 151 sub read_file {
 152
 153     my ( $file_name ) = @_ ;
 154
 155     local( *FH );
 156
 157     open( FH, $file_name ) || die "Can't open $file_name $!";
 158
 159     return <FH> if wantarray;
 160
 161     read FH, my $buf, -s FH;
 162     return $buf;
 163 }
 164
 165
 166 1;