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 sub ACTION_build {
  17
  18     my ( $self ) = @_;
  19
  20     if ( $self->config_data( 'build_demos' ) ) {
  21         $self->build_demo_scripts();
  22     }
  23
  24     if ( $self->config_data( 'build_ssfe' ) ) {
  25         $self->build_ssfe();
  26     }
  27
  28     $self->SUPER::ACTION_build();
  29 }
  30
  31
  32 # yes, hard coded, will fix some other time
  33 sub build_ssfe {
  34     my ( $self ) = @_;
  35     print "Compiling ssfe\n";
  36     system( "cd extras; tar xzf sirc-2.211.tar.gz; cp sirc-2.211/ssfe.c ../demo" );
  37     system( "cc -o demo/ssfe demo/ssfe.c -ltermcap 2>/dev/null" );
  38     $self->add_to_cleanup(qw(demo/ssfe demo/ssfe.c ));
  39 }
  40
  41
  42
  43 sub build_demo_scripts {
  44     my ( $self ) = @_;
  45
  46     my $demo_dir = 'demo';
  47
  48     my @files = <bin/demo/*>;
  49
  50     for my $file (@files) {
  51
  52         my $result = $self->copy_if_modified(
  53                     $file, $demo_dir, 'flatten');
  54
  55         next unless $result ;
  56
  57         $self->fix_shebang_line($result) if $self->is_unixish();
  58         $self->make_executable($result);
  59         $self->add_to_cleanup($result);
  60     }
  61
  62 }
  63
  64 ###########################################################
  65 # Find stem config files under the build dir and notify M::B about them.
  66 sub process_conf_files {
  67         my ( $self ) = @_ ;
  68         my $files = $self->_find_file_by_type('stem','conf');
  69         return unless keys %$files;
  70
  71         my $conf_dir = File::Spec->catdir($self->blib, 'conf');
  72         File::Path::mkpath( $conf_dir );
  73
  74         foreach my $file (keys %$files) {
  75                 my $result = $self->copy_if_modified(
  76                     $file, $conf_dir, 'flatten');
  77                 next unless $result;
  78         }
  79         return 1;
  80 }
  81
  82
  83 ###########################################################
  84 # A horrible hack to attempt to find the location of a binary program...
  85 # It would be nice if this functionality was already part of M::B
  86 # or there was a CPAN module for it that didn't suck.
  87 sub find_binary {
  88         my ( $self, $prog ) = @_ ;
  89         # make sure the command will succeed before extracting the path.
  90         if ( $self->do_system( "which $prog >/dev/null" ) ) {
  91                 my $path = `which $prog` ;
  92                 chomp $path;
  93                 return $path;
  94         }
  95         return;
  96 }
  97
  98
  99
 100 ###########################################################
 101 # Various convenience routines.
 102 #
 103 # To use ACTION_foo, call ./Build foo
 104
 105
 106
 107 # ACTION: grep through MANIFEST
 108 # command line args:
 109 #   files=<regex>
 110 #
 111 # do we need this action?
 112 #
 113
 114 sub ACTION_grep_manifest {
 115
 116     my( $self ) = @_ ;
 117
 118     my @manifest_sublist = $self->grep_manifest() ;
 119
 120     print join( "\n", @manifest_sublist ), "\n" ;
 121     return;
 122 }
 123
 124
 125
 126 # grep through all matched files
 127 # command line args:
 128 #   files=<regex> (default is all .pm files)
 129 #   re=<regex>
 130
 131 sub ACTION_grep {
 132
 133     my( $self ) = @_ ;
 134
 135     my $args = $self->{'args'} ;
 136
 137     my $file_regex = $args->{ files } || qr/\.pm$/ ;
 138     my $grep_regex = $args->{ re } or die "need grep regex" ;
 139
 140     my @manifest_sublist = $self->grep_manifest( $file_regex ) ;
 141
 142     local( @ARGV ) = @manifest_sublist ;
 143
 144     while( <> ) {
 145
 146         next unless /$grep_regex/ ;
 147
 148         print "$ARGV:$. $_"
 149     }
 150     continue {
 151
 152         close ARGV if eof ;
 153     }
 154
 155     return;
 156 }
 157
 158 my ( @manifest_lines ) ;
 159
 160 # MANIFEST helper subs
 161
 162 sub grep_manifest {
 163
 164     my( $self, $file_regex ) = @_ ;
 165
 166     $file_regex ||= $self->{ args }{ files } || qr/.*/ ;
 167
 168     manifest_load() ;
 169
 170     return grep( /$file_regex/, @manifest_lines ) ;
 171 }
 172
 173 sub manifest_load {
 174
 175     return if @manifest_lines ;
 176
 177     @manifest_lines = grep ! /^\s*$|^\s*#/, read_file( 'MANIFEST' ) ;
 178
 179     chomp @manifest_lines ;
 180
 181     return ;
 182 }
 183
 184 sub read_file {
 185
 186     my ( $file_name ) = @_ ;
 187
 188     local( *FH );
 189
 190     open( FH, $file_name ) || die "Can't open $file_name $!";
 191
 192     return <FH> if wantarray;
 193
 194     read FH, my $buf, -s FH;
 195     return $buf;
 196 }
 197
 198
 199 1;