source: devel/pb-modules/lib/ProjectBuilder/Base.pm @ 473

Last change on this file since 473 was 473, checked in by Bruno Cornec, 12 years ago

Working announce action for pb

File size: 8.8 KB
Line 
1#!/usr/bin/perl -w
2#
3# Base subroutines brought by the the Project-Builder project
4# which can be easily used by whatever perl project
5#
6# Copyright B. Cornec 2007-2008
7# Provided under the GPL v2
8#
9# $Id$
10#
11
12package ProjectBuilder::Base;
13
14use strict;
15use lib qw (lib);
16use File::Path;
17use File::Temp qw(tempdir);
18use Data::Dumper;
19use Time::localtime qw(localtime);
20use Pod::Usage;
21use English;
22
23# Inherit from the "Exporter" module which handles exporting functions.
24 
25use Exporter;
26 
27# Export, by default, all the functions into the namespace of
28# any code which uses this module.
29 
30our $debug = 0;         # Global debug level
31our $LOG = \*STDOUT;    # File descriptor of the log file
32our $synmsg = "Error";  # Global error message
33
34our @ISA = qw(Exporter);
35our @EXPORT = qw(pb_mkdir_p pb_system pb_rm_rf pb_get_date pb_log pb_log_init pb_get_uri pb_get_content pb_display_file pb_syntax_init pb_syntax pb_temp_init $debug $LOG);
36
37=pod
38
39=head1 NAME
40
41ProjectBuilder::Base, part of the project-builder.org - module dealing with generic functions suitable for perl project development
42
43=head1 DESCRIPTION
44
45This modules provides generic functions suitable for perl project development
46
47=head1 SYNOPSIS
48
49  use ProjectBuilder::Base;
50
51  #
52  # Create a directory and its parents
53  #
54  pb_mkdir_p("/tmp/foo/bar");
55
56  #
57  # Remove recursively a directory and its children
58  #
59  pb_rm_rf("/tmp/foo");
60
61  #
62  # Encapsulate the system call for better output and return value test
63  #
64  pb_system("ls -l", "Printing directory content");
65
66  #
67  # Analysis a URI and return its components in a table
68  #
69  my ($scheme, $account, $host, $port, $path) = pb_get_uri("svn+ssh://ac@my.server.org/path/to/dir");
70
71  #
72  # Gives the current date in a table
73  #
74  @date = pb_get_date();
75
76  #
77  # Manages logs of the program
78  #
79  pb_log_init(2,\*STDOUT);
80  pb_log(1,"Message to print\n");
81
82  #
83  # Manages content of a file
84  #
85  pb_display_file("/etc/passwd");
86  my $cnt = pb_get_content("/etc/passwd");
87
88=head1 USAGE
89
90=over 4
91
92=item B<pb_mkdir_p>
93
94Internal mkdir -p function. Forces mode to 755. Supports multiple parameters.
95
96Based on File::Path mkpath.
97
98=cut
99
100sub pb_mkdir_p {
101my @dir = @_;
102my $ret = mkpath(@dir, 0, 0755);
103return($ret);
104}
105
106=item B<pb_rm_rf>
107
108Internal rm -rf function. Supports multiple parameters.
109
110Based on File::Path rmtree.
111
112=cut
113
114sub pb_rm_rf {
115my @dir = @_;
116my $ret = rmtree(@dir, 0, 0);
117return($ret);
118}
119
120=item B<pb_system>
121
122Encapsulate the "system" call for better output and return value test
123Needs a $ENV{'PBTMP'} variable which is created by calling the pb_mktemp_init function
124Needs pb_log support, so pb_log_init should have benn called before.
125
126The first parameter is the shell command to call.
127The second parameter is the message to print on screen. If none is given, then the command is printed.
128The third parameter print the result of the command after correct execution if value is verbose. If value is noredir, it avoids redirecting outputs (e.g. for vi).
129This function returns the result the return value of the system command.
130
131If no error reported, it prints OK on the screen, just after the message. Else it prints the errors generated.
132
133=cut
134
135sub pb_system {
136
137my $cmd=shift;
138my $cmt=shift || $cmd;
139my $verbose=shift || undef;
140my $redir = "";
141
142pb_log(0,"$cmt... ");
143pb_log(1,"Executing $cmd\n");
144$redir = "2>&1 > $ENV{'PBTMP'}/system.log" if ((! defined $verbose) || ($verbose ne "noredir"));
145system("$cmd $redir");
146my $res = $?;
147if ($res == -1) {
148    pb_log(0,"failed to execute ($cmd): $!\n");
149    pb_display_file("$ENV{'PBTMP'}/system.log") if (-f "$ENV{'PBTMP'}/system.log");
150} elsif ($res & 127) {
151    pb_log(0, "child ($cmd) died with signal ".($? & 127).", ".($? & 128) ? 'with' : 'without'." coredump\n");
152    pb_display_file("$ENV{'PBTMP'}/system.log") if (-f "$ENV{'PBTMP'}/system.log");
153} elsif ($res == 0) {
154    pb_log(0,"OK\n");
155    pb_display_file("$ENV{'PBTMP'}/system.log") if ((defined $verbose) && (-f "$ENV{'PBTMP'}/system.log"));
156} else {
157    pb_log(0, "child ($cmd) exited with value ".($? >> 8)."\n");
158    pb_display_file("$ENV{'PBTMP'}/system.log") if (-f "$ENV{'PBTMP'}/system.log");
159}
160return($res);
161}
162
163=item B<pb_get_uri>
164
165This function returns a list of 6 parameters indicating the protocol, account, password, server, port, and path contained in the URI passed in parameter.
166
167A URI has the format protocol://[ac@]host[:port][path[?query][#fragment]].
168
169Cf man URI.
170
171=cut
172
173sub pb_get_uri {
174
175my $uri = shift || undef;
176
177pb_log(2,"DEBUG: uri:$uri\n");
178my ($scheme, $authority, $path, $query, $fragment) =
179         $uri =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?| if (defined $uri);
180my ($account,$host,$port) = $authority =~ m|(?:([^\@]+)\@)?([^:]+)(:(?:[0-9]+))?| if (defined $authority);
181
182$scheme = "" if (not defined $scheme);
183$authority = "" if (not defined $authority);
184$path = "" if (not defined $path);
185$account = "" if (not defined $account);
186$host = "" if (not defined $host);
187$port = "" if (not defined $port);
188
189pb_log(2,"DEBUG: scheme:$scheme ac:$account host:$host port:$port path:$path\n");
190return($scheme, $account, $host, $port, $path);
191}
192
193=item B<pb_get_date>
194
195This function returns a list of 9 parameters indicating the seconds, minutes, hours, day, month, year, day in the week, day in the year, and daylight saving time flag of the current time.
196
197Cf: man ctime and description of the struct tm.
198
199=cut
200
201sub pb_get_date {
202   
203return(localtime->sec(), localtime->min(), localtime->hour(), localtime->mday(), localtime->mon(), localtime->year(), localtime->wday(), localtime->yday(), localtime->isdst());
204}
205
206=item B<pb_log_init>
207
208This function initializes the global variables used by the pb_log function.
209
210The first parameter is the debug level which will be considered during the run of the program?
211The second parameter is a pointer on a file descriptor used to print the log info.
212
213As an example, if you set the debug level to 2 in that function, every call to pb_log which contains a value less or equal than 2 will be printed. Calls with a value greater than 2 won't be printed.
214
215The call to B<pb_log_init> is typically done after getting a parameter on the CLI indicating the level of verbosity expected.
216
217=cut
218
219sub pb_log_init {
220
221$debug = shift || 0;
222$LOG = shift || \*STDOUT;
223pb_log(1,"Debug value: $debug\n");
224
225} 
226
227=item B<pb_log>
228
229This function logs the messages passed as the second parameter if the value passed as first parameter is lesser or equal than the value passed to the B<pb_log_init> function.
230
231Here is a usage example:
232
233  pb_log_init(2,\*STDERR);
234  pb_log(1,"Hello World 1\n");
235  pb_log(2,"Hello World 2\n");
236  pb_log(3,"Hello World 3\n");
237
238  will print:
239 
240  Hello World 1
241  Hello World 2
242
243=cut 
244
245sub pb_log {
246
247my $dlevel = shift;
248my $msg = shift;
249
250print $LOG "$msg" if ($dlevel <= $debug);
251}
252
253=item B<pb_display_file>
254
255This function print the content of the file passed in parameter.
256
257This is a cat equivalent function.
258
259=cut
260
261sub pb_display_file {
262
263my $file=shift;
264
265return if (not -f $file);
266printf "%s\n",pb_get_content($file);
267}
268
269=item B<pb_get_content>
270
271This function returns the content of the file passed in parameter.
272
273=cut
274
275sub pb_get_content {
276
277my $file=shift;
278
279my $bkp = $/;
280undef $/;
281open(R,$file) || die "Unable to open $file: $!";
282my $content=<R>;
283close(R);
284chomp($content);
285$/ = $bkp;
286return($content);
287}
288
289=item B<pb_syntax_init>
290
291This function initializes the global variable used by the pb_syntax function.
292
293The parameter is the message string which will be printed when calling pb_syntax
294
295=cut
296
297sub pb_syntax_init {
298
299$synmsg = shift || "Error";
300}
301
302=item B<pb_syntax>
303
304This function prints the syntax expected by the application, based on pod2usage, and exits.
305The first parameter is the return value of the exit.
306The second parameter is the verbosity as expected by pod2usage.
307
308Cf: man Pod::Usage
309
310=cut
311
312sub pb_syntax {
313
314my $exit_status = shift || -1;
315my $verbose_level = shift || 0;
316
317my $filehandle = \*STDERR;
318
319$filehandle = \*STDOUT if ($exit_status == 0);
320
321pod2usage( { -message => $synmsg,
322             -exitval => $exit_status  ,
323             -verbose => $verbose_level,
324             -output  => $filehandle } );
325}
326
327=item B<pb_temp_init>
328
329This function initializes the environemnt variable PBTMP to a random value. This directory can be safely used during the whole program, it will be removed at the end automatically.
330
331=cut
332
333sub pb_temp_init {
334
335if (not defined $ENV{'TMPDIR'}) {
336    $ENV{'TMPDIR'}="/tmp";
337}
338$ENV{'PBTMP'} = tempdir( "pb.XXXXXXXXXX", DIR => $ENV{'TMPDIR'}, CLEANUP => 1 );
339}
340
341=back
342
343=head1 WEB SITES
344
345The main Web site of the project is available at L<http://www.project-builder.org/>. Bug reports should be filled using the trac instance of the project at L<http://trac.project-builder.org/>.
346
347=head1 USER MAILING LIST
348
349None exists for the moment.
350
351=head1 AUTHORS
352
353The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>.
354
355=head1 COPYRIGHT
356
357Project-Builder.org is distributed under the GPL v2.0 license
358described in the file C<COPYING> included with the distribution.
359
360=cut
361
3621;
Note: See TracBrowser for help on using the repository browser.