Commit | Line | Data |
b3407611 |
1 | package BuildStem; |
4536f655 |
2 | |
3 | use strict; |
b3407611 |
4 | use warnings; |
4536f655 |
5 | |
4536f655 |
6 | use Config; |
b3407611 |
7 | use File::Basename; |
8 | use File::Spec; |
9 | use IO::File; |
4536f655 |
10 | |
b3407611 |
11 | use Module::Build; |
4536f655 |
12 | |
b3407611 |
13 | use vars qw(@ISA); |
14 | @ISA = qw(Module::Build); |
4536f655 |
15 | |
3e03d89e |
16 | sub ACTION_build { |
4536f655 |
17 | |
3e03d89e |
18 | my ( $self ) = @_; |
b3407611 |
19 | |
3e03d89e |
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" ); |
09baddbd |
38 | $self->add_to_cleanup(qw(demo/ssfe demo/ssfe.c extras/sirc-2.211 )); |
3e03d89e |
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) { |
05cbee46 |
51 | |
3e03d89e |
52 | my $result = $self->copy_if_modified( |
53 | $file, $demo_dir, 'flatten'); |
05cbee46 |
54 | |
55 | next unless $result ; |
3e03d89e |
56 | |
57 | $self->fix_shebang_line($result) if $self->is_unixish(); |
58 | $self->make_executable($result); |
59 | $self->add_to_cleanup($result); |
60 | } |
b3407611 |
61 | |
4536f655 |
62 | } |
63 | |
3e03d89e |
64 | ########################################################### |
65 | # Find stem config files under the build dir and notify M::B about them. |
b3407611 |
66 | sub process_conf_files { |
4536f655 |
67 | my ( $self ) = @_ ; |
b3407611 |
68 | my $files = $self->_find_file_by_type('stem','conf'); |
69 | return unless keys %$files; |
4536f655 |
70 | |
b3407611 |
71 | my $conf_dir = File::Spec->catdir($self->blib, 'conf'); |
72 | File::Path::mkpath( $conf_dir ); |
4536f655 |
73 | |
b3407611 |
74 | foreach my $file (keys %$files) { |
3e03d89e |
75 | my $result = $self->copy_if_modified( |
76 | $file, $conf_dir, 'flatten'); |
77 | next unless $result; |
4536f655 |
78 | } |
b3407611 |
79 | return 1; |
4536f655 |
80 | } |
81 | |
3e03d89e |
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. |
b3407611 |
87 | sub find_binary { |
88 | my ( $self, $prog ) = @_ ; |
3e03d89e |
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; |
4536f655 |
94 | } |
4536f655 |
95 | return; |
96 | } |
97 | |
4536f655 |
98 | |
3e03d89e |
99 | |
afbe0126 |
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 | |
b3407611 |
199 | 1; |