#!/usr/bin/perl # ------------------------------------------------------------------------------ # (C) Crown copyright Met Office. All rights reserved. # For further details please refer to the file COPYRIGHT.txt # which you should have received as part of this distribution. # ------------------------------------------------------------------------------ use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Fcntl qw{:mode}; # for S_IXUSR, S_IXGRP, S_IXOTH, etc use File::Basename qw{dirname basename}; use File::Spec; use File::Temp qw{tempdir}; use FCM::Admin::Project; use FCM::Admin::Runner; use FCM::Admin::Util qw{ option2config run_create_archive run_html2pdf run_mkpath run_rename run_rmtree sed_file write_file }; use Getopt::Long qw{GetOptions}; use IO::Dir; use Pod::Usage qw{pod2usage}; use SVN::Client; main(); sub main { my %option = (); my $result = GetOptions( \%option, q{help|usage|h}, q{revision|r=s}, q{svn-live-dir=s}, q{svn-project-suffix=s}, ); if (!$result) { pod2usage(1); } if (exists($option{help})) { pod2usage(q{-verbose} => 1); } option2config(\%option); my $user_revision = exists($option{revision}) ? $option{revision} : q{HEAD}; if (@ARGV != 1) { my $message = sprintf( qq{Expected exactly 1 argument, %d given.}, scalar(@ARGV), ); pod2usage({q{-exitval} => 1, q{-message} => $message}); } my ($release_name) = @ARGV; my $out_file = "fcm-$release_name.tgz"; if (-e $out_file) { die("$out_file: already exists.\n"); } my $fcm_project = FCM::Admin::Project->new({name => q{FCM}}); my $fcm_repos_uri = $fcm_project->get_svn_file_uri(); my $revision = svn_info_revision($fcm_repos_uri, $user_revision); # Exports the trees of FCM and Admin to a temporary working area my $work_dir = tempdir(CLEANUP => 1); my $fcm_work_path = File::Spec->catfile($work_dir, q{fcm-} . $release_name); my $admin_work_path = File::Spec->catfile($work_dir, q{admin}); svn_export( join(q{/}, $fcm_repos_uri , qw{FCM trunk}), $fcm_work_path, $revision, ); svn_export( join(q{/}, $fcm_repos_uri , qw{Admin trunk}), $admin_work_path, $revision, ); manipulate_src_tree($fcm_work_path); manipulate_doc_tree($fcm_work_path); add_examples($fcm_work_path, $admin_work_path); add_tutorial(($fcm_work_path, $admin_work_path)); add_readme($fcm_work_path, $release_name, $revision); run_create_archive($out_file, $work_dir, basename($fcm_work_path)); } # ------------------------------------------------------------------------------ # Adds a README to the distribution. sub add_readme { my ($fcm_work_path, $release_name, $revision) = @_; write_file( File::Spec->catfile($fcm_work_path, q{README}), <<"README_FILE", FCM release $release_name created from revision $revision. For further details please refer to the release notes which can be found in the directory doc/release_notes. README_FILE ); } # ------------------------------------------------------------------------------ # Adds admin examples to the distribution. sub add_examples { my ($fcm_work_path, $admin_work_path) = @_; # Add utilities my $fcm_examples_path = File::Spec->catfile($fcm_work_path, qw{examples}); run_mkpath($fcm_examples_path); for my $path ( File::Spec->catfile($admin_work_path, qw{etc regular-update.eg}), glob(File::Spec->catfile($admin_work_path, qw{lib FCM*})), glob(File::Spec->catfile($admin_work_path, qw{sbin fcm-*})), ) { my $rel_path = File::Spec->abs2rel($path, $admin_work_path); my $new_path = File::Spec->catfile($fcm_examples_path, $rel_path); run_rename($path, $new_path); } # Add hooks my $fcm_example_hook_path = File::Spec->catfile($fcm_work_path, qw{examples svn-hooks}); my $admin_hook_path = File::Spec->catfile($admin_work_path, qw{svn-hooks}); run_mkpath($fcm_example_hook_path); for my $path (glob(File::Spec->catfile($admin_hook_path, q{*}))) { if (!-d $path) { my $new_path = File::Spec->catfile($fcm_example_hook_path, basename($path)); run_rename($path, $new_path); } } run_rename( File::Spec->catfile($admin_hook_path, qw{FCM background_updates.pl}), File::Spec->catfile($fcm_example_hook_path, q{background_updates.pl}), ); # Replaces FCM e-mail with an anonymous one for my $path ( glob(File::Spec->catfile($fcm_examples_path, qw{FCM Admin *})), glob(File::Spec->catfile($fcm_example_hook_path, q{*})), ) { sed_file( $path, sub { my ($line) = @_; $line =~ s{fcm\@metoffice\.gov\.uk} {my.name\@somewhere.org}gxms; return $line; }, ); } } # ------------------------------------------------------------------------------ # Adds the tutorial to the distribution. sub add_tutorial { my ($fcm_work_path, $admin_work_path) = @_; my $fcm_tutorial_path = File::Spec->catfile($fcm_work_path, q{tutorial}); my $admin_tutorial_path = File::Spec->catfile($admin_work_path, q{tutorial}); run_rename($admin_tutorial_path, $fcm_tutorial_path); my $admin_hook_tutorial_path = File::Spec->catfile($admin_work_path, qw{svn-hooks tutorial}); my $fcm_tutorial_hook_path = File::Spec->catfile($fcm_tutorial_path, q{hooks}); for my $path (glob(File::Spec->catfile($admin_hook_tutorial_path, q{*}))) { my $new_path = File::Spec->catfile($fcm_tutorial_hook_path, basename($path)); run_rename($path, $new_path); } my $fcm_example_svnperms_path = File::Spec->catfile( $fcm_work_path, qw{examples svn-hooks svnperms.py}, ); my $fcm_tutorial_svnperms_path = File::Spec->catfile($fcm_tutorial_hook_path, q{svnperms.py}); run_rename($fcm_example_svnperms_path, $fcm_tutorial_svnperms_path); } # ------------------------------------------------------------------------------ # Modifies the doc/ tree for the distribution. sub manipulate_doc_tree { my ($fcm_work_path) = @_; # Renames items in the documentation tree for my $path (glob(File::Spec->catfile($fcm_work_path, qw{doc * *.ppt}))) { run_rmtree($path); } sed_file( File::Spec->catfile($fcm_work_path, qw{doc etc fcm.js}), sub { my ($line) = @_; $line =~ s{\A(\s*URL_OF_TEAM:)\s*'.*',}{$1 null,}gxms; return $line; }, ); # Creates PDF versions of the documentations for ( [[qw{user_guide index.html} ], q{fcm-user-guide} ], [[qw{collaboration index.html} ], q{fcm-collaboration} ], [[qw{standards fortran_standard.html}], q{fcm-fortran-standard}], [[qw{standards perl_standard.html} ], q{fcm-perl-standard} ], ) { my ($html_path_ref, $pdf_name) = @{$_}; my $html_path = File::Spec->catfile($fcm_work_path, q{doc}, @{$html_path_ref}); my $pdf_path = File::Spec->catfile(dirname($html_path), "$pdf_name.pdf"); run_html2pdf($html_path, $pdf_path); } } # ------------------------------------------------------------------------------ # Modifies the src/ tree for the distribution. sub manipulate_src_tree { my ($fcm_work_path) = @_; run_rename( File::Spec->catfile($fcm_work_path, qw{etc fcm.cfg}), File::Spec->catfile($fcm_work_path, qw{etc fcm.cfg.eg}), ); } # ------------------------------------------------------------------------------ # Exports the Subversion URI "$from" (at $revision) to a path at "$to". sub svn_export { my ($from, $to, $revision) = @_; my $svn_client = SVN::Client->new(); FCM::Admin::Runner->instance()->run( "exporting $from to $to", sub {return $svn_client->export($from, $to, $revision, 0)}, ); } # ------------------------------------------------------------------------------ # Returns the actual revision of $svn_repos_uri (at a specified $user_revision). sub svn_info_revision { my ($svn_repos_uri, $user_revision) = @_; my $revision; my $svn_client = SVN::Client->new(); $svn_client->info( $svn_repos_uri, $user_revision, $user_revision, sub {$revision = $_[1]->rev()}, 1, ); if (!$revision) { die("$svn_repos_uri: cannot determine actual revision.\n"); } return $revision; } __END__ =head1 NAME fcm-create-release =head1 SYNOPSIS fcm-create-release [--revision=REV] RELEASE-NAME =head1 DESCRIPTION Creates a release of FCM in a compressed-tar ball. =head1 ARGUMENTS =over 4 =item RELEASE-NAME The name of the release =back =head1 OPTIONS =over 4 =item --help, -h, --usage Prints help and exits. =item --revision=REV, -rREV Specifies a revision of the trunk for creating the release. If not specified, the program uses the last commit revision at the HEAD of the trunk. =item --svn-live-dir=DIR Specifies the root location of the live directory of Subversion repositories. See L for the current default. =item --svn-project-suffix=NAME Specifies the suffix added to the project name for Subversion repositories. The default is "_svn". =back =head1 SEE ALSO L, L, L, L =head1 COPYRIGHT E<169> Crown copyright Met Office. All rights reserved. =cut