[1980] | 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 | |
---|
| 8 | use strict; |
---|
| 9 | use warnings; |
---|
| 10 | |
---|
| 11 | use FindBin; |
---|
| 12 | use lib "$FindBin::Bin/../lib"; |
---|
| 13 | use File::Basename qw{basename}; |
---|
| 14 | use File::Spec; |
---|
| 15 | use Pod::Usage qw{pod2usage}; |
---|
| 16 | |
---|
| 17 | use FCM::Admin::Config; |
---|
| 18 | use FCM::Admin::Runner; |
---|
| 19 | use FCM::Admin::System qw{ |
---|
| 20 | distribute_wc |
---|
| 21 | filter_projects |
---|
| 22 | get_projects_from_svn_live |
---|
| 23 | install_svn_hook |
---|
| 24 | }; |
---|
| 25 | use 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 | # ------------------------------------------------------------------------------ |
---|
| 35 | my $CONFIG = FCM::Admin::Config->instance(); |
---|
| 36 | my %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 | |
---|
| 46 | if (!caller()) { |
---|
| 47 | main(@ARGV); |
---|
| 48 | } |
---|
| 49 | |
---|
| 50 | # ------------------------------------------------------------------------------ |
---|
| 51 | # The main logic. |
---|
| 52 | sub 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. |
---|
| 130 | sub 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. |
---|
| 144 | sub 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. |
---|
| 154 | sub 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 | |
---|
| 173 | fcm-commit-update |
---|
| 174 | |
---|
| 175 | =head1 SYNOPSIS |
---|
| 176 | |
---|
| 177 | fcm-commit-update REPOS-NAME LOG-DIR-PATH |
---|
| 178 | |
---|
| 179 | =head1 DESCRIPTION |
---|
| 180 | |
---|
| 181 | This program performs the post-commit update for the FCM system. It runs |
---|
| 182 | continuously until no more update is available. It prevent another copy from |
---|
| 183 | running by creating a lock. If another copy detects a lock, it exits without |
---|
| 184 | doing anything. |
---|
| 185 | |
---|
| 186 | =head1 ARGUMENTS |
---|
| 187 | |
---|
| 188 | =over 4 |
---|
| 189 | |
---|
| 190 | =item REPOS-NAME |
---|
| 191 | |
---|
| 192 | The name of the repository invoking this program. |
---|
| 193 | |
---|
| 194 | =item LOG-DIR-PATH |
---|
| 195 | |
---|
| 196 | The path to the log directory. |
---|
| 197 | |
---|
| 198 | =back |
---|
| 199 | |
---|
| 200 | =head1 COPYRIGHT |
---|
| 201 | |
---|
| 202 | E<169> Crown copyright Met Office. All rights reserved. |
---|
| 203 | |
---|
| 204 | =cut |
---|