source: XIOS/tools/FCM/examples/sbin/fcm-commit-update @ 1385

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

ajout FCM 1.5

File size: 6.3 KB
Line 
1#!/usr/bin/perl
2# ------------------------------------------------------------------------------
3# (C) Crown copyright Met Office. All rights reserved.
4# For further details please refer to the file COPYRIGHT.txt
5# which you should have received as part of this distribution.
6# ------------------------------------------------------------------------------
7
8use strict;
9use warnings;
10
11use FindBin;
12use lib "$FindBin::Bin/../lib";
13use File::Basename qw{basename};
14use File::Spec;
15use Pod::Usage qw{pod2usage};
16
17use FCM::Admin::Config;
18use FCM::Admin::Runner;
19use FCM::Admin::System qw{
20    distribute_wc
21    filter_projects
22    get_projects_from_svn_live
23    install_svn_hook
24};
25use FCM::Admin::Util qw{
26    run_html2pdf
27    run_mkpath
28    run_rmtree
29    run_svn_info
30    run_svn_update
31    write_file
32};
33
34# ------------------------------------------------------------------------------
35my $CONFIG = FCM::Admin::Config->instance();
36my %PATTERN_OF = (
37    q{}             => qr{.*}xms,
38    DOC_COLLAB      => qr{doc/collaboration/}xms,
39    DOC_STD_FORTRAN => qr{doc/standards/fortran_standard\.html}xms,
40    DOC_STD_PERL    => qr{doc/standards/perl_standard\.html}xms,
41    DOC_UG          => qr{doc/user_guide/}xms,
42    SRC             => qr{(?:bin|etc|lib|man)/}xms,
43    SRC_HOOK        => qr{svn-hooks/}xms,
44);
45
46if (!caller()) {
47    main(@ARGV);
48}
49
50# ------------------------------------------------------------------------------
51# The main logic.
52sub main {
53    if (@_ != 2) {
54        my $message = sprintf(qq{Expect 2 arguments, %d given}, scalar(@_));
55        pod2usage({q{-exitval} => 1, q{-message} => $message});
56    }
57    my ($repos_name, $log_dir_path) = @_;
58    create_lock($repos_name, $log_dir_path) || return;
59    my $RUNNER = FCM::Admin::Runner->instance();
60    UPDATE:
61    while (1) {
62        my @updates_in_fcm   = run_svn_update($CONFIG->get_fcm_wc());
63        my @updates_in_admin = run_svn_update($CONFIG->get_fcm_admin_wc());
64        if (!@updates_in_fcm && !@updates_in_admin) {
65            last UPDATE;
66        }
67        for my $task ((
68            {
69                name => '(re-)installing hook scripts',
70                main => sub {
71                    for my $project (get_projects_from_svn_live()) {
72                        install_svn_hook($project);
73                    }
74                    return 1;
75                },
76                want => get_pattern_grepper('SRC_HOOK', 1), # in "Admin"
77            },
78            {
79                name => 'updating FCM release number file',
80                main => sub {
81                    my $root = $CONFIG->get_fcm_wc();
82                    write_file(
83                        File::Spec->catfile($root, qw{etc fcm_rev}),
84                        run_svn_info($root)->last_changed_rev(),
85                    );
86                },
87                want => get_pattern_grepper(q{}),
88            },
89            {
90                name => 'generating PDF for the user guide',
91                main => get_fcm_html2pdf('user_guide', 'user-guide'),
92                want => get_pattern_grepper('DOC_UG'),
93            },
94            {
95                name => 'generating PDF for the collaboration guide',
96                main => get_fcm_html2pdf('collaboration', 'collaboration'),
97                want => get_pattern_grepper('DOC_COLLAB'),
98            },
99            {
100                name => 'generating PDF for the FCM Fortran Standard document',
101                main => get_fcm_html2pdf(
102                    'standards', 'fortran-standard', 'fortran_standard',
103                ),
104                want => get_pattern_grepper('DOC_STD_FORTRAN'),
105            },
106            {
107                name => 'generating PDF for the FCM Perl Standard document',
108                main => get_fcm_html2pdf(
109                    'standards', 'perl-standard', 'perl_standard',
110                ),
111                want => get_pattern_grepper('DOC_STD_PERL'),
112            },
113            {
114                name => 'distributing FCM to standard locations',
115                main => \&distribute_wc,
116                want => get_pattern_grepper('SRC'),
117            },
118        )) {
119            if ($task->{want}->(\@updates_in_fcm, \@updates_in_admin)) {
120                $RUNNER->run($task->{name}, $task->{main});
121            }
122        }
123    }
124}
125
126# ------------------------------------------------------------------------------
127# Returns a wrapper of run_html2pdf, base on the relative $path in the doc/
128# sub-directory of the central FCM working copy pointing to the container
129# directory of the input and output.
130sub get_fcm_html2pdf {
131    my ($path, $name_of_output, $name_of_input) = @_;
132    my $container = File::Spec->catfile($CONFIG->get_fcm_wc(), 'doc', $path);
133    my $input = File::Spec->catfile(
134        $container, ($name_of_input ? $name_of_input : 'index') . '.html',
135    );
136    my $output = File::Spec->catfile($container, "fcm-$name_of_output.pdf");
137    return sub {run_html2pdf($input, $output)};
138}
139
140# ------------------------------------------------------------------------------
141# Returns a function that "grep" for a known pattern ($pattern_key). The
142# returned function expects a list reference in the $index'th (default = 0)
143# element of its argument list.
144sub get_pattern_grepper {
145    my ($pattern_key, $index) = @_;
146    if (!defined($index)) {
147        $index = 0;
148    }
149    return sub {grep({$_ =~ $PATTERN_OF{$pattern_key}} @{$_[$index]})};
150}
151
152# ------------------------------------------------------------------------------
153# Creates a lock. Returns true on success. Removes lock when program finishes.
154sub create_lock {
155    my ($repos_name, $log_dir_path) = @_;
156    my $lock = File::Spec->catfile($log_dir_path, $repos_name . '.lock');
157    if (-e $lock) {
158        $lock = undef;
159        return;
160    }
161    return run_mkpath($lock);
162    END {
163        if ($lock) {
164            run_rmtree($lock);
165        }
166    }
167}
168
169__END__
170
171=head1 NAME
172
173fcm-commit-update
174
175=head1 SYNOPSIS
176
177    fcm-commit-update REPOS-NAME LOG-DIR-PATH
178
179=head1 DESCRIPTION
180
181This program performs the post-commit update for the FCM system. It runs
182continuously until no more update is available. It prevent another copy from
183running by creating a lock. If another copy detects a lock, it exits without
184doing anything.
185
186=head1 ARGUMENTS
187
188=over 4
189
190=item REPOS-NAME
191
192The name of the repository invoking this program.
193
194=item LOG-DIR-PATH
195
196The path to the log directory.
197
198=back
199
200=head1 COPYRIGHT
201
202E<169> Crown copyright Met Office. All rights reserved.
203
204=cut
Note: See TracBrowser for help on using the repository browser.