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 | |
4536f655 |
16 | |
17 | sub 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 |
42 | sub 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 |
58 | sub 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 | |
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 | |
b3407611 |
166 | 1; |