added some of uri's utility actions for build script
[urisagit/Stem.git] / BuildStem.pm
CommitLineData
b3407611 1package BuildStem;
4536f655 2
3use strict;
b3407611 4use warnings;
4536f655 5
4536f655 6use Config;
b3407611 7use File::Basename;
8use File::Spec;
9use IO::File;
4536f655 10
b3407611 11use Module::Build;
4536f655 12
b3407611 13use vars qw(@ISA);
14@ISA = qw(Module::Build);
4536f655 15
4536f655 16
17sub process_script_files {
4536f655 18 my ( $self ) = @_ ;
b3407611 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 );
6b34fa66 26 $self->add_to_cleanup($demo_dir);
b3407611 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);
4536f655 37 }
38 }
b3407611 39 return 1;
4536f655 40}
41
b3407611 42sub process_conf_files {
4536f655 43 my ( $self ) = @_ ;
b3407611 44 my $files = $self->_find_file_by_type('stem','conf');
45 return unless keys %$files;
4536f655 46
b3407611 47 my $conf_dir = File::Spec->catdir($self->blib, 'conf');
48 File::Path::mkpath( $conf_dir );
4536f655 49
6b34fa66 50
b3407611 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();
4536f655 54 }
b3407611 55 return 1;
4536f655 56}
57
b3407611 58sub find_binary {
59 my ( $self, $prog ) = @_ ;
60 if ( $self->do_system( "which $prog >/dev/null" ) ) {
61 return `which $prog` ;
4536f655 62 }
4536f655 63 return;
64}
65
4536f655 66
afbe0126 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
81sub 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
98sub 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
125my ( @manifest_lines ) ;
126
127# MANIFEST helper subs
128
129sub 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
140sub 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
151sub 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
b3407611 1661;