source: XMLIO_V2/tools/FCM/examples/lib/FCM/Admin/Util.pm @ 81

Last change on this file since 81 was 81, checked in by ymipsl, 11 years ago

ajout FCM 1.5

File size: 11.2 KB
Line 
1# ------------------------------------------------------------------------------
2# (C) Crown copyright Met Office. All rights reserved.
3# For further details please refer to the file COPYRIGHT.txt
4# which you should have received as part of this distribution.
5# ------------------------------------------------------------------------------
6
7use strict;
8use warnings;
9
10package FCM::Admin::Util;
11
12use Exporter qw{import};
13use FCM::Admin::Config;
14use FCM::Admin::Runner;
15use File::Basename qw{dirname};
16use File::Copy qw{copy};
17use File::Path qw{mkpath rmtree};
18use File::Temp qw{tempfile};
19use IO::File;
20use SVN::Client;
21
22our @EXPORT_OK = qw{
23    option2config
24    read_file
25    run_copy
26    run_create_archive
27    run_extract_archive
28    run_html2pdf
29    run_mkpath
30    run_rename
31    run_rmtree
32    run_rsync
33    run_svn_info
34    run_svn_update
35    run_symlink
36    sed_file
37    write_file
38};
39
40my @HTML2PS = qw{html2ps -n -U -W b};
41my @PS2PDF  = qw{
42    ps2pdf
43    -dMaxSubsetPct=100
44    -dCompatibilityLevel=1.3
45    -dSubsetFonts=true
46    -dEmbedAllFonts=true
47    -dAutoFilterColorImages=false
48    -dAutoFilterGrayImages=false
49    -dColorImageFilter=/FlateEncode
50    -dGrayImageFilter=/FlateEncode
51    -dMonoImageFilter=/FlateEncode
52    -sPAPERSIZE=a4
53};
54
55# ------------------------------------------------------------------------------
56# Loads values of an option hash into the configuration.
57sub option2config {
58    my ($option_ref) = @_;
59    my $config = FCM::Admin::Config->instance();
60    for my $key (keys(%{$option_ref})) {
61        my $method = $key;
62        $method =~ s{-}{_}gxms;
63        $method = "set_$method";
64        if ($config->can($method)) {
65            $config->$method($option_ref->{$key});
66        }
67    }
68    return 1;
69}
70
71# ------------------------------------------------------------------------------
72# Reads lines from a file.
73sub read_file {
74    my ($path, $sub_ref) = @_;
75    my $file = IO::File->new($path);
76    if (!defined($file)) {
77        die("$path: cannot open for reading ($!).\n");
78    }
79    while (my $line = $file->getline()) {
80        $sub_ref->($line);
81    }
82    $file->close() || die("$path: cannot close for reading ($!).\n");
83    return 1;
84}
85
86# ------------------------------------------------------------------------------
87# Runs copy with checks and diagnostics.
88sub run_copy {
89    my ($source_path, $dest_path) = @_;
90    FCM::Admin::Runner->instance()->run(
91        "copy $source_path to $dest_path",
92        sub {
93            my $rc = copy($source_path, $dest_path);
94            if (!$rc) {
95                die($!);
96            }
97            return $rc;
98        },
99    );
100}
101
102# ------------------------------------------------------------------------------
103# Creates a TAR-GZIP archive.
104sub run_create_archive {
105    my ($archive_path, $work_dir, @base_names) = @_;
106    FCM::Admin::Runner->instance()->run(
107        "creating archive $archive_path",
108        sub {
109            return !system(
110                qw{tar -c -z},
111                q{-C} => $work_dir,
112                q{-f} => $archive_path,
113                @base_names,
114            );
115            # Note: can use Archive::Tar, but "tar" is much faster.
116        },
117    );
118}
119
120# ------------------------------------------------------------------------------
121# Extracts from a TAR-GZIP archive.
122sub run_extract_archive {
123    my ($archive_path, $work_dir) = @_;
124    FCM::Admin::Runner->instance()->run(
125        "extracting archive $archive_path",
126        sub {
127            return !system(
128                qw{tar -x -z},
129                q{-C} => $work_dir,
130                q{-f} => $archive_path,
131            );
132            # Note: can use Archive::Tar, but "tar" is much faster.
133        },
134    );
135}
136
137# ------------------------------------------------------------------------------
138# Runs html2ps and ps2pdf.
139sub run_html2pdf {
140    my ($html_path, $pdf_path, $option_ref) = @_;
141    # Note: "html2ps" is currently installed at ~fcm/bin/
142    my $FCM_HOME_BIN = File::Spec->catfile(
143        FCM::Admin::Config->instance()->get_fcm_home(), q{bin},
144    );
145    local(%ENV) = %ENV;
146    $ENV{PATH} = join(q{:}, $FCM_HOME_BIN, $ENV{PATH});
147    my $html2ps_config;
148    if (ref($option_ref) && exists($option_ref->{config})) {
149        $html2ps_config = $option_ref->{config};
150    }
151    else {
152        my $file
153            = File::Spec->catfile(dirname($html_path), q{style.html2ps.css});
154        if (-f $file && -r $file) {
155            $html2ps_config = $file;
156        }
157    }
158    my ($fh, $ps_path) = tempfile(UNLINK => 1);
159    close($fh);
160    my @html2ps = (
161        @HTML2PS,
162        ($html2ps_config ? (q{-f} => $html2ps_config) : ()),
163        q{-o} => $ps_path,
164        $html_path,
165    );
166    FCM::Admin::Runner->instance()->run(
167        "converting $html_path to PS format",
168        sub {return !system(@html2ps)},
169    );
170    my @ps2pdf = (@PS2PDF, $ps_path, $pdf_path);
171    FCM::Admin::Runner->instance()->run(
172        "converting PS format to $pdf_path",
173        sub {return !system(@ps2pdf)},
174    );
175}
176
177# ------------------------------------------------------------------------------
178# Runs mkpath with checks and diagnostics.
179sub run_mkpath {
180    my ($path) = @_;
181    if (!-d $path) {
182        FCM::Admin::Runner->instance()->run(
183            "creating $path",
184            sub {return mkpath($path)},
185        );
186    }
187    return 1;
188}
189
190# ------------------------------------------------------------------------------
191# Runs rename with checks and diagnostics.
192sub run_rename {
193    my ($source_path, $dest_path) = @_;
194    FCM::Admin::Runner->instance()->run(
195        "renaming $source_path to $dest_path",
196        sub {
197            run_mkpath(dirname($dest_path));
198            my $rc = rename($source_path, $dest_path);
199            if (!$rc) {
200                die($!);
201            }
202            return $rc;
203        },
204    );
205    return 1;
206}
207
208# ------------------------------------------------------------------------------
209# Runs rmtree with checks and diagnostics.
210sub run_rmtree {
211    my ($path) = @_;
212    if (-e $path) {
213        FCM::Admin::Runner->instance()->run(
214            "removing $path",
215            sub {
216                rmtree($path);
217                return !-e $path;
218            },
219        );
220    }
221    return 1;
222}
223
224# ------------------------------------------------------------------------------
225# Runs rsync.
226sub run_rsync {
227    my ($sources_ref, $dest_path, $option_list_ref) = @_;
228    FCM::Admin::Runner->instance()->run(
229        sprintf('mirroring %s <- %s', $dest_path, join(q{ }, @{$sources_ref})),
230        sub {return !system(
231            q{rsync},
232            ($option_list_ref ? @{$option_list_ref} : ()),
233            @{$sources_ref},
234            $dest_path,
235        )},
236    );
237    return 1;
238}
239
240# ------------------------------------------------------------------------------
241# Runs "svn info".
242sub run_svn_info {
243    my ($path) = @_;
244    my $return;
245    my $ctx = SVN::Client->new();
246    $ctx->info($path, undef, 'WORKING', sub {$return = $_[1]}, 0);
247    return $return;
248}
249
250# ------------------------------------------------------------------------------
251# Runs "svn update".
252sub run_svn_update {
253    my ($path) = @_;
254    my @return;
255    my $ctx = SVN::Client->new(
256        notify => sub {
257            if ($path ne $_[0]) {
258                push(@return, $_[0]);
259            }
260        }
261    );
262    $ctx->update($path, 'HEAD', 1);
263    return @return;
264}
265
266# ------------------------------------------------------------------------------
267# Runs symlink with checks and diagnostics.
268sub run_symlink {
269    my ($source_path, $dest_path) = @_;
270    FCM::Admin::Runner->instance()->run(
271        "creating symlink: $source_path -> $dest_path",
272        sub {
273            my $rc = symlink($source_path, $dest_path);
274            if (!$rc) {
275                die($!);
276            }
277            return $rc;
278        },
279    );
280    return 1;
281}
282
283# ------------------------------------------------------------------------------
284# Edits content of a file.
285sub sed_file {
286    my ($path, $sub_ref) = @_;
287    my @lines;
288    read_file(
289        $path,
290        sub {
291            my ($line) = @_;
292            $line = $sub_ref->($line);
293            push(@lines, $line);
294        },
295    );
296    write_file($path, @lines);
297}
298
299# ------------------------------------------------------------------------------
300# Writes content to a file.
301sub write_file {
302    my ($path, @contents) = @_;
303    my $file = IO::File->new($path, q{w});
304    if (!defined($file)) {
305        die("$path: cannot open for writing ($!).\n");
306    }
307    for my $content (@contents) {
308        $file->print($content);
309    }
310    $file->close() || die("$path: cannot close for writing ($!).\n");
311    return 1;
312}
313
3141;
315__END__
316
317=head1 NAME
318
319FCM::Admin::Util
320
321=head1 SYNOPSIS
322
323    use FCM::Admin::Util qw{ ... };
324    # ... see descriptions of individual functions for detail
325
326=head1 DESCRIPTION
327
328This module contains utility functions for the administration of Subversion
329repositories and Trac environments hosted by the FCM team.
330
331=head1 FUNCTIONS
332
333=over 4
334
335=item option2config($option_ref)
336
337Loads the values of an option hash into
338L<FCM::Admin::Config|FCM::Admin::Config>.
339
340=item read_file($path,$sub_ref)
341
342Reads from $path. For each $line the file, calls $sub_ref->($line).
343
344=item run_copy($source_path,$dest_path)
345
346Copies $source_path to $dest_path, with diagnostic.
347
348=item run_create_archive($archive_path,$work_dir,@base_names)
349
350Creates a TAR-GZIP archive at $archive_path using $work_dir as the working
351directory and @base_names as members of the archive. Depends on GNU "tar" or
352compatible.
353
354=item run_extract_archive($archive_path,$work_dir)
355
356Extracts a TAR-GZIP archive at $archive_path using $work_dir as the working
357directory. Depends on GNU "tar" or compatible.
358
359=item run_html2pdf($html_path,$pdf_path,$option_ref)
360
361Converts a HTML document at $html_path to PDF format, and writes the results to
362$pdf_path. If $option_ref is set, it must be a reference to a HASH with the
363element "config". If the value of $option_ref->{config} is set to an existing
364path, it is used by "html2ps" as the configuration file. Depends on "html2ps"
365and "ps2pdf".
366
367=item run_mkpath($path)
368
369Creates $path if it does not already exist, with diagnostic.
370
371=item run_rename($source_path,$dest_path)
372
373Same as the core I<rename>, but with diagnostic.
374
375=item run_rmtree($path)
376
377Removes $path, with diagnostic.
378
379=item run_rsync(\@sources,$dest_path,$option_list_ref)
380
381Invokes the "rsync" shell command with diagnostics to mirror the paths in
382@sources to $dest_path. Command line options can be specified in a list with
383$option_list_ref. Depends on "rsync".
384
385=item run_svn_info($path)
386
387Wrapper of the info() method of L<SVN::Client|SVN::Client>. Expects $path to be
388a Subversion working copy. Returns the C<svn_info_t> object as described by the
389info() method of L<SVN::Client|SVN::Client>.
390
391=item run_svn_update($path)
392
393Wrapper of the update() method of L<SVN::Client|SVN::Client>. Expects $path to be
394a Subversion working copy. Returns a list of updated paths.
395
396=item run_symlink($source_path,$dest_path)
397
398Same as the core I<symlink>, but with diagnostic.
399
400=item sed_file($path,$sub_ref)
401
402For each $line in $path, runs $line = $sub_ref->($line). Writes results back to
403$path.
404
405=item write_file($path,$content)
406
407Writes $content to $path.
408
409=back
410
411=head1 SEE ALSO
412
413L<FCM::Admin::Config|FCM::Admin::Config>,
414L<FCM::Admin::Runner|FCM::Admin::Runner>,
415L<SVN::Client|SVN::Client>
416
417=head1 COPYRIGHT
418
419E<169> Crown copyright Met Office. All rights reserved.
420
421=cut
Note: See TracBrowser for help on using the repository browser.