File Coverage

blib/lib/Rex/Apache/Inject/Properties.pm
Criterion Covered Total %
statement 33 164 20.1
branch 0 74 0.0
condition n/a
subroutine 11 21 52.3
pod 0 4 0.0
total 44 263 16.7


line stmt bran cond sub pod time code
1             #
2             # (c) Jan Gehring
3             #
4             # vim: set ts=2 sw=2 tw=0:
5             # vim: set expandtab:
6              
7             package Rex::Apache::Inject::Properties;
8              
9             =begin
10              
11             =head2 SYNOPSIS
12              
13             This is a (R)?ex module to ease the deployments of PHP, Perl or other languages.
14              
15             =cut
16              
17 1     1   1512 use strict;
  1         3  
  1         25  
18 1     1   5 use warnings;
  1         2  
  1         24  
19              
20 1     1   5 use Rex::Commands::Run;
  1         2  
  1         7  
21 1     1   81 use Rex::Commands::Fs;
  1         1  
  1         6  
22 1     1   437 use Rex::Commands::Upload;
  1         2  
  1         6  
23 1     1   44 use Rex::Commands;
  1         2  
  1         5  
24 1     1   778 use Rex::Config;
  1         2  
  1         8  
25 1     1   73 use File::Basename qw(dirname basename);
  1         3  
  1         54  
26 1     1   5 use Cwd qw(getcwd);
  1         2  
  1         45  
27              
28             #require Exporter;
29             #use base qw(Exporter);
30              
31 1     1   5 use vars qw(@EXPORT $real_name_from_template $template_file $template_pattern);
  1         1  
  1         1888  
32             @EXPORT = qw(inject
33             generate_real_name
34             template_file template_search_for);
35              
36             my $work_dir = getcwd;
37              
38             ############ deploy functions ################
39              
40             sub inject {
41 0     0 0   my ( $to, @options ) = @_;
42              
43 0           my $option = {@options};
44              
45 0           my $tmp_to = $to;
46 0 0         if ( $tmp_to !~ m/^\// ) { $tmp_to = "../$tmp_to"; }
  0            
47              
48 0           my $cmd1 = sprintf( _get_extract_command($to), "$tmp_to" );
49 0           my $cmd2 = sprintf( _get_pack_command($to), "$tmp_to", "." );
50              
51 0           my $template_params = _get_template_params($template_file);
52              
53 0           mkdir("tmp");
54 0           chdir("tmp");
55 0           run $cmd1;
56              
57 0 0         if ( exists $option->{"extract"} ) {
58 0           for my $file_pattern ( @{ $option->{"extract"} } ) {
  0            
59              
60 0           my $find = "find ../ -name '$file_pattern'";
61 0 0         if ( $^O =~ m/^MSWin/i ) {
62 0           $find = "find2 ../ -name \"$file_pattern\"";
63             }
64              
65 0           for my $found_file (`$find`) {
66 0           chomp $found_file;
67              
68 0           mkdir "tmp-b";
69 0           chdir "tmp-b";
70              
71 0           my $extract_cmd =
72             sprintf( _get_extract_command($found_file), "../$found_file" );
73 0           my $compress_cmd =
74             sprintf( _get_pack_command($found_file), "../$found_file", "." );
75              
76 0           run $extract_cmd;
77              
78 0           _find_and_parse_templates();
79              
80 0 0         if ( exists $option->{"pre_pack_hook"} ) {
81 0           &{ $option->{"pre_pack_hook"} }($found_file);
  0            
82             }
83              
84 0           run $compress_cmd;
85              
86 0 0         if ( exists $option->{"post_pack_hook"} ) {
87 0           &{ $option->{"post_pack_hook"} }($found_file);
  0            
88             }
89              
90 0           chdir "..";
91 0           rmdir "tmp-b";
92             }
93              
94             }
95             }
96              
97 0           _find_and_parse_templates();
98              
99 0 0         if ( exists $option->{"pre_pack_hook"} ) {
100 0           &{ $option->{"pre_pack_hook"} };
  0            
101             }
102              
103 0           run $cmd2;
104 0 0         if ( $? != 0 ) {
105 0           chdir("..");
106 0           system("rm -rf tmp");
107 0           die("Can't re-pack archive. Please check permissions. Command was: $cmd2");
108             }
109              
110 0 0         if ( exists $option->{"post_pack_hook"} ) {
111 0           &{ $option->{"post_pack_hook"} };
  0            
112             }
113              
114 0           chdir("..");
115 0           system("rm -rf tmp");
116             }
117              
118             sub _find_and_parse_templates {
119              
120 0     0     my $template_params = _get_template_params($template_file);
121              
122 0           my $find = "find . -name '$template_pattern'";
123 0 0         if ( $^O =~ m/^MSWin/i ) {
124 0           $find = "find2 . -name \"$template_pattern\"";
125             }
126              
127 0           for my $file (`$find`) {
128 0           $/ = "\n";
129 0           chomp $file;
130 0           Rex::Logger::debug("Opening file $file");
131              
132 0 0         open( my $fh, "<$file" ) or die($!);
133 0           my %con;
134 0           while ( my $line = <$fh> ) {
135 0           chomp $line;
136 0           $line =~ s/\r//gs;
137 0 0         next if ( $line =~ /^#/ );
138 0 0         next if ( $line =~ /^$/ );
139              
140 0           my ( $key, $val ) = $line =~ m/^(.*?)\s?[=:]\s?(.*)$/;
141 0           Rex::Logger::debug("key: -$key- => val: -$val-");
142              
143 0 0         unless ($key) {
144 0           Rex::Logger::info("Parser Error in $file:");
145 0           Rex::Logger::info("($.)===$line===");
146 0           next;
147             }
148 0 0         $val = "" unless $val;
149 0           $con{$key} = $val;
150             }
151 0           close($fh);
152              
153 0           for my $k ( keys %$template_params ) {
154 0           Rex::Logger::debug( "(t): -$k- => -" . $template_params->{$k} . "-" );
155 0 0         if ( exists $con{$k} ) {
156             Rex::Logger::info(
157 0           "setting $k to " . $template_params->{$k} . " ($file)" );
158 0           $con{$k} = $template_params->{$k};
159             }
160              
161             # else {
162             # Rex::Logger::info("$k doesn't exists in $file");
163             # }
164             }
165              
166 0 0         my $new_file_name =
167             $real_name_from_template ? &$real_name_from_template($file) : $file;
168 0           Rex::Logger::debug("Writing file $new_file_name");
169 0 0         open( $fh, ">", $new_file_name ) or die($!);
170 0           for my $key ( keys %con ) {
171 0           print $fh "$key=" . $con{$key} . "\n";
172             }
173 0           close($fh);
174             }
175              
176             }
177              
178             ############ configuration functions #############
179              
180             sub generate_real_name {
181 0     0 0   $real_name_from_template = shift;
182             }
183              
184             sub template_file {
185 0     0 0   $template_file = shift;
186             }
187              
188             sub template_search_for {
189 0     0 0   $template_pattern = shift;
190             }
191              
192             ############ helper functions #############
193              
194             sub _get_extract_command {
195 0     0     my ($file) = @_;
196              
197 0 0         if ( $file =~ m/\.tar\.gz$/ ) {
    0          
    0          
    0          
    0          
198 0           return "tar xzf %s";
199             }
200             elsif ( $file =~ m/\.zip$/ ) {
201 0           return "unzip %s";
202             }
203             elsif ( $file =~ m/\.tar\.bz2$/ ) {
204 0           return "tar xjf %s";
205             }
206             elsif ( $file =~ m/\.war$/ ) {
207 0           return "unzip %s";
208             }
209             elsif ( $file =~ m/\.jar$/ ) {
210 0           return "unzip %s";
211             }
212              
213 0           die("Unknown Archive Format.");
214             }
215              
216             sub _get_pack_command {
217 0     0     my ($file) = @_;
218              
219 0 0         if ( $file =~ m/\.tar\.gz$/ ) {
    0          
    0          
    0          
    0          
220 0           return "tar czf %s %s";
221             }
222             elsif ( $file =~ m/\.zip$/ ) {
223 0           return "zip -r %s %s";
224             }
225             elsif ( $file =~ m/\.tar\.bz2$/ ) {
226 0           return "tar cjf %s %s";
227             }
228             elsif ( $file =~ m/\.war$/ ) {
229 0           return "zip -r %s %s";
230             }
231             elsif ( $file =~ m/\.jar$/ ) {
232 0           return "zip -r %s %s";
233             }
234              
235 0           die("Unknown Archive Format.");
236             }
237              
238             # read the template file and return a hashref.
239             sub _get_template_params {
240 0     0     my %inject;
241              
242             my $t_file;
243              
244 0 0         if ( $template_file =~ m/^\// ) {
245 0           $t_file = $template_file;
246             }
247             else {
248 0           $t_file = "$work_dir/$template_file";
249             }
250              
251 0 0         if ( -f "$t_file." . Rex::Config->get_environment ) {
252 0           $t_file = "$t_file." . Rex::Config->get_environment;
253             }
254              
255 0 0         open( my $fh, "<", $t_file ) or die($!);
256 0           while ( my $line = <$fh> ) {
257 0           chomp $line;
258 0           $line =~ s/\r//gs;
259 0 0         next if ( $line =~ /^#/ );
260 0 0         next if ( $line =~ /^$/ );
261 0           $line =~ s/\r//gs;
262              
263 0           my ( $key, $val ) = $line =~ m/^(.*?)\s?[=:\t]\s?(.*)$/;
264 0           $inject{$key} = $val;
265             }
266 0           close($fh);
267              
268 0           return \%inject;
269             }
270              
271             sub _get_ext {
272 0     0     my ($file) = @_;
273              
274 0 0         if ( $file =~ m/\.tar\.gz$/ ) {
    0          
    0          
    0          
    0          
275 0           return ".tar.gz";
276             }
277             elsif ( $file =~ m/\.zip$/ ) {
278 0           return ".zip";
279             }
280             elsif ( $file =~ m/\.tar\.bz2$/ ) {
281 0           return ".tar.bz2";
282             }
283             elsif ( $file =~ m/\.war$/ ) {
284 0           return ".war";
285             }
286             elsif ( $file =~ m/\.jar$/ ) {
287 0           return ".jar";
288             }
289              
290 0           die("Unknown Archive Format.");
291              
292             }
293              
294             ####### import function #######
295              
296             sub import {
297              
298 1     1   6 no strict 'refs';
  1         1  
  1         101  
299 0     0     for my $func (@EXPORT) {
300 0           Rex::Logger::debug("Registering main::$func");
301 0           *{"$_[1]::$func"} = \&$func;
  0            
302             }
303              
304             }
305              
306             1;