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