[1980] | 1 | # ------------------------------------------------------------------------------ |
---|
| 2 | # NAME |
---|
| 3 | # Fcm::Cm |
---|
| 4 | # |
---|
| 5 | # DESCRIPTION |
---|
| 6 | # This module contains the FCM code management functionalities and wrappers |
---|
| 7 | # to Subversion commands. |
---|
| 8 | # |
---|
| 9 | # COPYRIGHT |
---|
| 10 | # (C) Crown copyright Met Office. All rights reserved. |
---|
| 11 | # For further details please refer to the file COPYRIGHT.txt |
---|
| 12 | # which you should have received as part of this distribution. |
---|
| 13 | # ------------------------------------------------------------------------------ |
---|
| 14 | use strict; |
---|
| 15 | use warnings; |
---|
| 16 | |
---|
| 17 | package Fcm::Cm; |
---|
| 18 | use base qw{Exporter}; |
---|
| 19 | |
---|
| 20 | our @EXPORT_OK = qw(cli cm_check_missing cm_check_unknown cm_switch cm_update); |
---|
| 21 | |
---|
| 22 | use Cwd qw{cwd}; |
---|
| 23 | use Getopt::Long qw{GetOptions :config bundling}; |
---|
| 24 | use Fcm::CLI::Exception; |
---|
| 25 | use Fcm::Config; |
---|
| 26 | use Fcm::CmBranch; |
---|
| 27 | use Fcm::CmUrl; |
---|
| 28 | use Fcm::Keyword; |
---|
| 29 | use Fcm::Util qw{ |
---|
| 30 | get_url_of_wc |
---|
| 31 | get_url_peg_of_wc |
---|
| 32 | get_wct |
---|
| 33 | is_url |
---|
| 34 | is_wc |
---|
| 35 | run_command |
---|
| 36 | tidy_url |
---|
| 37 | }; |
---|
| 38 | use File::Basename qw{basename dirname}; |
---|
| 39 | use File::Path qw{mkpath rmtree}; |
---|
| 40 | use File::Spec; |
---|
| 41 | use File::Temp qw{tempfile}; |
---|
| 42 | use Pod::Usage qw{pod2usage}; |
---|
| 43 | |
---|
| 44 | # ------------------------------------------------------------------------------ |
---|
| 45 | |
---|
| 46 | # CLI message handler |
---|
| 47 | our $CLI_MESSAGE = \&_cli_message; |
---|
| 48 | |
---|
| 49 | # List of CLI messages |
---|
| 50 | our %CLI_MESSAGE_FOR = ( |
---|
| 51 | q{} => "%s", |
---|
| 52 | BRANCH_LIST => "%s at %s: %d branch(es) found for %s.\n", |
---|
| 53 | CHDIR_WCT => "%s: working directory changed to top of working copy.\n", |
---|
| 54 | CF => "Conflicts in: %s\n", |
---|
| 55 | MERGE => "Performing merge ...\n", |
---|
| 56 | MERGE_CF => "About to merge in changes from %s compared with %s\n", |
---|
| 57 | MERGE_CI => "The following is added to the commit message file:\n%s", |
---|
| 58 | MERGE_DRY => "This merge will result in the following change:\n", |
---|
| 59 | MERGE_REVS => "Merge(s) available from %s: %s\n", |
---|
| 60 | OUT_DIR => "Output directory: %s\n", |
---|
| 61 | PATCH_DONE => "%s: patch generated.\n", |
---|
| 62 | PATCH_REV => "Patch created for changeset %s\n", |
---|
| 63 | SEPARATOR => q{-} x 80 . "\n", |
---|
| 64 | STATUS => "Status of the target working copy(ies):\n%s", |
---|
| 65 | ); |
---|
| 66 | |
---|
| 67 | # CLI abort and error messages |
---|
| 68 | our %CLI_MESSAGE_FOR_ABORT = ( |
---|
| 69 | FAIL => "%s: command failed.\n", |
---|
| 70 | NULL => "%s: command will result in no change.\n", |
---|
| 71 | USER => "%s: abort by user.\n", |
---|
| 72 | ); |
---|
| 73 | |
---|
| 74 | # CLI abort and error messages |
---|
| 75 | our %CLI_MESSAGE_FOR_ERROR = ( |
---|
| 76 | CHDIR => "%s: cannot change to directory.\n", |
---|
| 77 | CLI => "%s", |
---|
| 78 | CLI_HELP => "Type 'fcm help %s' for usage.\n", |
---|
| 79 | CLI_MERGE_ARG1 => "Arg 1 must be the source in auto/custom mode.\n", |
---|
| 80 | CLI_MERGE_ARG2 => "Arg 2 must be the source in custom mode" |
---|
| 81 | . " if --revision not set.\n", |
---|
| 82 | CLI_OPT_ARG => "--%s: invalid argument [%s].\n", |
---|
| 83 | CLI_OPT_WITH_OPT => "--%s: must be specified with --%s.\n", |
---|
| 84 | CLI_USAGE => "incorrect usage", |
---|
| 85 | DIFF_PROJECTS => "%s (target) and %s (source) are not related.\n", |
---|
| 86 | INVALID_BRANCH => "%s: not a valid URL of a standard FCM branch.\n", |
---|
| 87 | INVALID_PROJECT => "%s: not a valid URL of a standard FCM project.\n", |
---|
| 88 | INVALID_TARGET => "%s: not a valid working copy or URL.\n", |
---|
| 89 | INVALID_URL => "%s: not a valid URL.\n", |
---|
| 90 | INVALID_WC => "%s: not a valid working copy.\n", |
---|
| 91 | MERGE_REV_INVALID => "%s: not a revision in the available merge list.\n", |
---|
| 92 | MERGE_SELF => "%s: cannot be merged to its own working copy: %s.\n", |
---|
| 93 | MERGE_UNRELATED => "%s: target and %s: source not directly related.\n", |
---|
| 94 | MERGE_UNSAFE => "%s: source contains changes outside the target" |
---|
| 95 | . " sub-directory. Please merge with a full tree.\n", |
---|
| 96 | MKPATH => "%s: cannot create directory.\n", |
---|
| 97 | NOT_EXIST => "%s: does not exist.\n", |
---|
| 98 | PARENT_NOT_EXIST => "%s: parent %s no longer exists.\n", |
---|
| 99 | RMTREE => "%s: cannot remove.\n", |
---|
| 100 | ST_CONFLICT => "File(s) in conflicts:\n%s", |
---|
| 101 | ST_MISSING => "File(s) missing:\n%s", |
---|
| 102 | ST_OUT_OF_DATE => "File(s) out of date:\n%s", |
---|
| 103 | SWITCH_UNSAFE => "%s: merge template exists." |
---|
| 104 | . " Please remove before retrying.\n", |
---|
| 105 | WC_EXIST => "%s: working copy already exists.\n", |
---|
| 106 | WC_INVALID_BRANCH => "%s: not a working copy of a standard FCM branch.\n", |
---|
| 107 | WC_URL_NOT_EXIST => "%s: working copy URL does not exists at HEAD.\n", |
---|
| 108 | ); |
---|
| 109 | |
---|
| 110 | # List of CLI prompt messages |
---|
| 111 | our %CLI_MESSAGE_FOR_PROMPT = ( |
---|
| 112 | CF_OVERWRITE => qq{%s: existing changes will be overwritten.\n} |
---|
| 113 | . qq{ Do you wish to continue?}, |
---|
| 114 | CI => qq{Would you like to commit this change?}, |
---|
| 115 | CI_BRANCH_SHARED => qq{\n} |
---|
| 116 | . qq{*** WARNING: YOU ARE COMMITTING TO A %s BRANCH.\n} |
---|
| 117 | . qq{*** Please ensure that you have the} |
---|
| 118 | . qq{ owner's permission.\n\n} |
---|
| 119 | . qq{Would you like to commit this change?}, |
---|
| 120 | CI_BRANCH_USER => qq{\n} |
---|
| 121 | . qq{*** WARNING: YOU ARE COMMITTING TO A BRANCH} |
---|
| 122 | . qq{ NOT OWNED BY YOU.\n} |
---|
| 123 | . qq{*** Please ensure that you have the} |
---|
| 124 | . qq{ owner's permission.\n\n} |
---|
| 125 | . qq{Would you like to commit this change?}, |
---|
| 126 | CI_TRUNK => qq{\n} |
---|
| 127 | . qq{*** WARNING: YOU ARE COMMITTING TO THE TRUNK.\n} |
---|
| 128 | . qq{*** Please ensure that your change conforms to} |
---|
| 129 | . qq{ your project's working practices.\n\n} |
---|
| 130 | . qq{Would you like to commit this change?}, |
---|
| 131 | CONTINUE => qq{Are you sure you want to continue?}, |
---|
| 132 | MERGE => qq{Would you like to go ahead with the merge?}, |
---|
| 133 | MERGE_REV => qq{Please enter the revision you wish to merge from}, |
---|
| 134 | MKPATCH_OVERWRITE => qq{%s: output location exists. OK to overwrite?}, |
---|
| 135 | RUN_SVN_COMMAND => qq{Would you like to run "svn %s"?}, |
---|
| 136 | ); |
---|
| 137 | |
---|
| 138 | # List of CLI warning messages |
---|
| 139 | our %CLI_MESSAGE_FOR_WARNING = ( |
---|
| 140 | BRANCH_SUBDIR => "%s: is a sub-directory of a branch in a FCM project.\n", |
---|
| 141 | CF_BINARY => "%s: ignoring binary file, please resolve manually.\n", |
---|
| 142 | INVALID_BRANCH => $CLI_MESSAGE_FOR_ERROR{INVALID_BRANCH}, |
---|
| 143 | ST_IN_TRAC_DIFF => "%s: local changes cannot be displayed in Trac.\n" |
---|
| 144 | ); |
---|
| 145 | |
---|
| 146 | # CLI prompt handler and title prefix |
---|
| 147 | our $CLI_PROMPT = \&_cli_prompt; |
---|
| 148 | our $CLI_PROMPT_PREFIX = q{fcm }; |
---|
| 149 | |
---|
| 150 | # List of exception handlers [$class, CODE->($function, $e)] |
---|
| 151 | our @CLI_EXCEPTION_HANDLERS = ( |
---|
| 152 | ['Fcm::CLI::Exception', \&_cli_e_handler_of_cli_exception], |
---|
| 153 | ['Fcm::Cm::Exception' , \&_cli_e_handler_of_cm_exception], |
---|
| 154 | ['Fcm::Cm::Abort' , \&_cli_e_handler_of_cm_abort], |
---|
| 155 | ); |
---|
| 156 | |
---|
| 157 | # Event handlers |
---|
| 158 | our %CLI_HANDLER_OF = ( |
---|
| 159 | 'WC_STATUS' => \&_cli_handler_of_wc_status, |
---|
| 160 | 'WC_STATUS_PATH' => \&_cli_handler_of_wc_status_path, |
---|
| 161 | ); |
---|
| 162 | |
---|
| 163 | # Handlers of sub-commands |
---|
| 164 | our %CLI_IMPL_OF = ( |
---|
| 165 | 'add' => \&_cli_command_add, |
---|
| 166 | 'branch' => \&cm_branch, |
---|
| 167 | 'commit' => \&cm_commit, |
---|
| 168 | 'conflicts' => \&cm_conflicts, |
---|
| 169 | 'checkout' => \&_cli_command_checkout, |
---|
| 170 | 'delete' => \&_cli_command_delete, |
---|
| 171 | 'diff' => \&cm_diff, |
---|
| 172 | 'merge' => \&cm_merge, |
---|
| 173 | 'mkpatch' => \&cm_mkpatch, |
---|
| 174 | 'switch' => \&_cli_command_switch, |
---|
| 175 | 'update' => \&_cli_command_update, |
---|
| 176 | ); |
---|
| 177 | |
---|
| 178 | # List of overridden subcommands that need to display "svn help" |
---|
| 179 | our %CLI_MORE_HELP_FOR = map {($_, 1)} qw{add diff delete switch update}; |
---|
| 180 | |
---|
| 181 | # The preferred name of subcommand aliases |
---|
| 182 | our %CLI_PREFERRED_NAME_OF = ( |
---|
| 183 | 'ann' => 'blame', |
---|
| 184 | 'annotate' => 'blame', |
---|
| 185 | 'br' => 'branch', |
---|
| 186 | 'ci' => 'commit', |
---|
| 187 | 'cf' => 'conflicts', |
---|
| 188 | 'co' => 'checkout', |
---|
| 189 | 'cp' => 'copy', |
---|
| 190 | 'del' => 'delete', |
---|
| 191 | 'di' => 'diff', |
---|
| 192 | 'ls' => 'list', |
---|
| 193 | 'mv' => 'move', |
---|
| 194 | 'pd' => 'propdel', |
---|
| 195 | 'pdel' => 'propdel', |
---|
| 196 | 'pe' => 'propedit', |
---|
| 197 | 'pedit' => 'propedit', |
---|
| 198 | 'pg' => 'propget', |
---|
| 199 | 'pget' => 'propget', |
---|
| 200 | 'pl' => 'proplist', |
---|
| 201 | 'plist' => 'proplist', |
---|
| 202 | 'praise' => 'blame', |
---|
| 203 | 'ps' => 'propset', |
---|
| 204 | 'pset' => 'propset', |
---|
| 205 | 'remove' => 'delete', |
---|
| 206 | 'ren' => 'move', |
---|
| 207 | 'rename' => 'move', |
---|
| 208 | 'rm' => 'delete', |
---|
| 209 | 'sw' => 'switch', |
---|
| 210 | 'up' => 'update', |
---|
| 211 | ); |
---|
| 212 | |
---|
| 213 | # List of subcommands that accept URL inputs |
---|
| 214 | our %CLI_SUBCOMMAND_URL = map {($_, 1)} qw{ |
---|
| 215 | blame |
---|
| 216 | branch |
---|
| 217 | cat |
---|
| 218 | checkout |
---|
| 219 | copy |
---|
| 220 | delete |
---|
| 221 | diff |
---|
| 222 | export |
---|
| 223 | import |
---|
| 224 | info |
---|
| 225 | list |
---|
| 226 | lock |
---|
| 227 | log |
---|
| 228 | merge |
---|
| 229 | mkdir |
---|
| 230 | mkpatch |
---|
| 231 | move |
---|
| 232 | propdel |
---|
| 233 | propedit |
---|
| 234 | propget |
---|
| 235 | proplist |
---|
| 236 | propset |
---|
| 237 | switch |
---|
| 238 | unlock |
---|
| 239 | }; |
---|
| 240 | |
---|
| 241 | # List of subcommands that accept revision inputs |
---|
| 242 | our %CLI_SUBCOMMAND_REV = map {($_, 1)} qw{ |
---|
| 243 | blame |
---|
| 244 | branch |
---|
| 245 | cat |
---|
| 246 | checkout |
---|
| 247 | copy |
---|
| 248 | diff |
---|
| 249 | export |
---|
| 250 | info |
---|
| 251 | list |
---|
| 252 | log |
---|
| 253 | merge |
---|
| 254 | mkpatch |
---|
| 255 | move |
---|
| 256 | propdel |
---|
| 257 | propedit |
---|
| 258 | propget |
---|
| 259 | proplist |
---|
| 260 | propset |
---|
| 261 | switch |
---|
| 262 | }; |
---|
| 263 | |
---|
| 264 | # Common patterns |
---|
| 265 | our %PATTERN_OF = ( |
---|
| 266 | # A CLI option |
---|
| 267 | CLI_OPT => qr{ |
---|
| 268 | \A (?# beginning) |
---|
| 269 | (--\w[\w-]*=) (?# capture 1, a long option label) |
---|
| 270 | (.*) (?# capture 2, the value of the option) |
---|
| 271 | \z (?# end) |
---|
| 272 | }xms, |
---|
| 273 | # A CLI revision option |
---|
| 274 | CLI_OPT_REV => qr{ |
---|
| 275 | \A (?# beginning) |
---|
| 276 | (--revision(?:=|\z)|-r) (?# capture 1, --revision, --revision= or -r) |
---|
| 277 | (.*) (?# capture 2, trailing value) |
---|
| 278 | \z (?# end) |
---|
| 279 | }xms, |
---|
| 280 | # A CLI revision option range |
---|
| 281 | CLI_OPT_REV_RANGE => qr{ |
---|
| 282 | \A (?# beginning) |
---|
| 283 | ( (?# capture 1, begin) |
---|
| 284 | (?:\{[^\}]+\}+) (?# a date in curly braces) |
---|
| 285 | | (?# or) |
---|
| 286 | [^:]+ (?# anything but a colon) |
---|
| 287 | ) (?# capture 1, end) |
---|
| 288 | (?::(.*))? (?# colon, and capture 2 til the end) |
---|
| 289 | \z (?# end) |
---|
| 290 | }xms, |
---|
| 291 | # A FCM branch path look-alike, should be configurable in the future |
---|
| 292 | FCM_BRANCH_PATH => qr{ |
---|
| 293 | \A (?# beginning) |
---|
| 294 | /* (?# some slashes) |
---|
| 295 | (?: (?# group 1, begin) |
---|
| 296 | (?:trunk/*(?:@\d+)?\z) (?# trunk at a revision) |
---|
| 297 | | (?# or) |
---|
| 298 | (?:trunk|branches|tags)/+ (?# trunk, branch or tags) |
---|
| 299 | ) (?# group 1, end) |
---|
| 300 | }xms, |
---|
| 301 | # Last line of output from "svn status -u" |
---|
| 302 | ST_AGAINST_REV => qr{ |
---|
| 303 | \A (?# beginning) |
---|
| 304 | Status\sagainst\srevision:.* (?# output of svn status -u) |
---|
| 305 | \z (?# end) |
---|
| 306 | }xms, |
---|
| 307 | # Extract path from "svn status" |
---|
| 308 | ST_PATH => qr{ |
---|
| 309 | \A (?# beginning) |
---|
| 310 | .{6} (?# 6 columns) |
---|
| 311 | \s+ (?# spaces) |
---|
| 312 | (.+) (?# capture 1, target path) |
---|
| 313 | \z (?# end) |
---|
| 314 | }xms, |
---|
| 315 | # A legitimate "svn" revision |
---|
| 316 | SVN_REV => qr{ |
---|
| 317 | \A (?# beginning) |
---|
| 318 | (?:\d+|HEAD|BASE|COMMITTED|PREV|\{.+\}) (?# digit, reserved words, date) |
---|
| 319 | \z (?# end) |
---|
| 320 | }ixms, |
---|
| 321 | ); |
---|
| 322 | |
---|
| 323 | # Status matchers |
---|
| 324 | our %ST_MATCHER_FOR = ( |
---|
| 325 | MISSING => sub {substr($_[0], 0, 1) eq '!'}, |
---|
| 326 | MODIFIED => sub {substr($_[0], 0, 6) =~ qr{\S}xms}, |
---|
| 327 | OUT_OF_DATE => sub {substr($_[0], 7, 1) eq '*'}, |
---|
| 328 | UNKNOWN => sub {substr($_[0], 0, 1) eq '?'}, |
---|
| 329 | ); |
---|
| 330 | |
---|
| 331 | # ------------------------------------------------------------------------------ |
---|
| 332 | # Entry function for the FCM code management CLI. Calls the relevant FCM code |
---|
| 333 | # management function or SVN command based on $function. |
---|
| 334 | sub cli { |
---|
| 335 | my ($function, @args) = @_; |
---|
| 336 | if (exists($CLI_PREFERRED_NAME_OF{$function})) { |
---|
| 337 | $function = $CLI_PREFERRED_NAME_OF{$function}; |
---|
| 338 | } |
---|
| 339 | if (grep {$_ eq '-h' || $_ eq '--help'} @args) { |
---|
| 340 | return _cli_help($function, 'NOEXIT'); |
---|
| 341 | } |
---|
| 342 | if (exists($CLI_SUBCOMMAND_URL{$function})) { |
---|
| 343 | _cli_keyword_expand_url(\@args); |
---|
| 344 | } |
---|
| 345 | if (exists($CLI_SUBCOMMAND_REV{$function})) { |
---|
| 346 | _cli_keyword_expand_rev(\@args); |
---|
| 347 | } |
---|
| 348 | if (exists($CLI_IMPL_OF{$function})) { |
---|
| 349 | eval { |
---|
| 350 | local(@ARGV) = @args; |
---|
| 351 | return $CLI_IMPL_OF{$function}->(@args); |
---|
| 352 | }; |
---|
| 353 | if ($@) { |
---|
| 354 | my $e = $@; |
---|
| 355 | for (@CLI_EXCEPTION_HANDLERS) { |
---|
| 356 | my ($class, $handler) = @{$_}; |
---|
| 357 | if ($class->caught($e)) { |
---|
| 358 | return $handler->($function, $e); |
---|
| 359 | } |
---|
| 360 | } |
---|
| 361 | die($e); |
---|
| 362 | } |
---|
| 363 | } |
---|
| 364 | else { |
---|
| 365 | return _svn($function, @args); |
---|
| 366 | } |
---|
| 367 | } |
---|
| 368 | |
---|
| 369 | # ------------------------------------------------------------------------------ |
---|
| 370 | # SYNOPSIS |
---|
| 371 | # &Fcm::Cm::cm_branch (); |
---|
| 372 | # |
---|
| 373 | # DESCRIPTION |
---|
| 374 | # This is a FCM command to check information, create or delete a branch in |
---|
| 375 | # a Subversion repository. |
---|
| 376 | # ------------------------------------------------------------------------------ |
---|
| 377 | |
---|
| 378 | sub cm_branch { |
---|
| 379 | # Process command line options |
---|
| 380 | # ---------------------------------------------------------------------------- |
---|
| 381 | my ( |
---|
| 382 | $info, |
---|
| 383 | $delete, |
---|
| 384 | $create, |
---|
| 385 | $list, |
---|
| 386 | $branch_of_branch, |
---|
| 387 | $name, |
---|
| 388 | $non_interactive, |
---|
| 389 | $password, |
---|
| 390 | $rev, |
---|
| 391 | $rev_flag, |
---|
| 392 | $show_all, |
---|
| 393 | $show_children, |
---|
| 394 | $show_other, |
---|
| 395 | $show_siblings, |
---|
| 396 | $svn_non_interactive, |
---|
| 397 | @tickets, |
---|
| 398 | $type, |
---|
| 399 | @userlist, |
---|
| 400 | $verbose, |
---|
| 401 | ); |
---|
| 402 | my $rc = GetOptions( |
---|
| 403 | 'info|i' => \$info, |
---|
| 404 | 'delete|d' => \$delete, |
---|
| 405 | 'create|c' => \$create, |
---|
| 406 | 'list|l' => \$list, |
---|
| 407 | 'branch-of-branch' => \$branch_of_branch, |
---|
| 408 | 'name|n=s' => \$name, |
---|
| 409 | 'non-interactive' => \$non_interactive, |
---|
| 410 | 'password=s' => \$password, |
---|
| 411 | 'revision|r=s' => \$rev, |
---|
| 412 | 'rev-flag=s' => \$rev_flag, |
---|
| 413 | 'show-all|a' => \$show_all, |
---|
| 414 | 'show-children' => \$show_children, |
---|
| 415 | 'show-other' => \$show_other, |
---|
| 416 | 'show-siblings' => \$show_siblings, |
---|
| 417 | 'svn-non-interactive' => \$svn_non_interactive, |
---|
| 418 | 'ticket|k=s' => \@tickets, |
---|
| 419 | 'type|t=s' => \$type, |
---|
| 420 | 'user|u=s' => \@userlist, |
---|
| 421 | 'verbose|v' => \$verbose, |
---|
| 422 | ); |
---|
| 423 | if (!$rc) { |
---|
| 424 | _cli_err(); |
---|
| 425 | } |
---|
| 426 | |
---|
| 427 | my $num_options = 0; |
---|
| 428 | $num_options++ if defined $info; |
---|
| 429 | $num_options++ if defined $delete; |
---|
| 430 | $num_options++ if defined $create; |
---|
| 431 | $num_options++ if defined $list; |
---|
| 432 | if ($num_options > 1) { |
---|
| 433 | _cli_err(); |
---|
| 434 | } |
---|
| 435 | |
---|
| 436 | # Get URL of repository or branch |
---|
| 437 | # ---------------------------------------------------------------------------- |
---|
| 438 | my $url; |
---|
| 439 | if ($ARGV[0]) { |
---|
| 440 | $url = Fcm::CmUrl->new (URL => $ARGV[0]); |
---|
| 441 | |
---|
| 442 | if (not $url->is_url) { |
---|
| 443 | # An argument is specified and is not a URL |
---|
| 444 | # Assume that it is a path with a working copy |
---|
| 445 | if (&is_wc ($ARGV[0])) { |
---|
| 446 | $url = Fcm::CmUrl->new (URL => &get_url_of_wc ($ARGV[0])); |
---|
| 447 | |
---|
| 448 | } else { |
---|
| 449 | return _cm_err(Fcm::Cm::Exception->INVALID_WC, $ARGV[0]); |
---|
| 450 | } |
---|
| 451 | } |
---|
| 452 | |
---|
| 453 | } else { |
---|
| 454 | # An argument is not specified |
---|
| 455 | # Assume that the current directory is a working copy |
---|
| 456 | if (&is_wc ()) { |
---|
| 457 | $url = Fcm::CmUrl->new (URL => &get_url_of_wc ()); |
---|
| 458 | |
---|
| 459 | } else { |
---|
| 460 | return _cm_err(Fcm::Cm::Exception->INVALID_TARGET, '.'); |
---|
| 461 | } |
---|
| 462 | } |
---|
| 463 | |
---|
| 464 | # Ensure $url->url_peg is a URL of a standard FCM project |
---|
| 465 | if (!$url->project_url()) { |
---|
| 466 | return _cm_err(Fcm::Cm::Exception->INVALID_PROJECT, $url->url_peg()); |
---|
| 467 | } |
---|
| 468 | |
---|
| 469 | if ($create) { |
---|
| 470 | # The --create option is specified, create a branch |
---|
| 471 | # -------------------------------------------------------------------------- |
---|
| 472 | |
---|
| 473 | # Check branch type flags |
---|
| 474 | if ($type) { |
---|
| 475 | $type = uc ($type); |
---|
| 476 | |
---|
| 477 | if ($type =~ /^(USER|SHARE)$/) { |
---|
| 478 | $type = 'DEV' . $Fcm::Config::DELIMITER . $1; |
---|
| 479 | |
---|
| 480 | } elsif ($type =~ /^(CONFIG|REL)$/) { |
---|
| 481 | $type = 'PKG' . $Fcm::Config::DELIMITER . $1; |
---|
| 482 | |
---|
| 483 | } elsif ($type =~ /^(DEV|TEST|PKG)$/) { |
---|
| 484 | $type = $1 . $Fcm::Config::DELIMITER . 'USER'; |
---|
| 485 | |
---|
| 486 | } elsif ($type !~ /^(?:DEV|TEST|PKG)$Fcm::Config::DELIMITER(?:USER|SHARE)$/ |
---|
| 487 | and $type !~ /^PKG$Fcm::Config::DELIMITER(?:CONFIG|REL)/) { |
---|
| 488 | _cli_err('CLI_OPT_ARG', 'type', $type); |
---|
| 489 | } |
---|
| 490 | |
---|
| 491 | } else { |
---|
| 492 | $type = 'DEV' . $Fcm::Config::DELIMITER . 'USER'; |
---|
| 493 | } |
---|
| 494 | |
---|
| 495 | # Check branch name |
---|
| 496 | if (!$name) { |
---|
| 497 | _cli_err('CLI_OPT_WITH_OPT', 'name', 'create'); |
---|
| 498 | } |
---|
| 499 | |
---|
| 500 | if ($name !~ qr{\A[\w.-]+\z}xms) { |
---|
| 501 | _cli_err('CLI_OPT_ARG', 'name', $name); |
---|
| 502 | } |
---|
| 503 | |
---|
| 504 | # Check revision flag is valid |
---|
| 505 | if ($rev_flag) { |
---|
| 506 | $rev_flag = uc ($rev_flag); |
---|
| 507 | if ($rev_flag !~ qr{\A (?:NORMAL|NUMBER|NONE) \z}xms) { |
---|
| 508 | _cli_err('CLI_OPT_ARG', 'rev-flag', $rev_flag); |
---|
| 509 | } |
---|
| 510 | |
---|
| 511 | } else { |
---|
| 512 | $rev_flag = 'NORMAL'; |
---|
| 513 | } |
---|
| 514 | |
---|
| 515 | # Handle multiple tickets |
---|
| 516 | @tickets = split ( |
---|
| 517 | /$Fcm::Config::DELIMITER_LIST/, |
---|
| 518 | join ($Fcm::Config::DELIMITER_LIST, @tickets) |
---|
| 519 | ); |
---|
| 520 | s/^#// for (@tickets); |
---|
| 521 | @tickets = sort {$a <=> $b} @tickets; |
---|
| 522 | |
---|
| 523 | # Determine whether to create a branch of a branch |
---|
| 524 | $url->branch ('trunk') unless $branch_of_branch; |
---|
| 525 | |
---|
| 526 | # Create the branch |
---|
| 527 | my $branch = Fcm::CmBranch->new; |
---|
| 528 | $branch->create ( |
---|
| 529 | SRC => $url, |
---|
| 530 | TYPE => $type, |
---|
| 531 | NAME => $name, |
---|
| 532 | PASSWORD => $password, |
---|
| 533 | REV_FLAG => $rev_flag, |
---|
| 534 | TICKET => \@tickets, |
---|
| 535 | REV => $rev, |
---|
| 536 | NON_INTERACTIVE => $non_interactive, |
---|
| 537 | SVN_NON_INTERACTIVE => $svn_non_interactive, |
---|
| 538 | ); |
---|
| 539 | |
---|
| 540 | } elsif ($list) { |
---|
| 541 | # The option --list is specified |
---|
| 542 | # List branches owned by current or specified users |
---|
| 543 | # -------------------------------------------------------------------------- |
---|
| 544 | # Get URL of the project "branches/" sub-directory |
---|
| 545 | $url->subdir (''); |
---|
| 546 | $url->branch (''); |
---|
| 547 | |
---|
| 548 | my @branches = $url->branch_list($rev); |
---|
| 549 | if (!$show_all) { |
---|
| 550 | @userlist = split(qr{:}xms, join(q{:}, @userlist)); |
---|
| 551 | if (!@userlist) { |
---|
| 552 | @userlist = (Fcm::Config->instance()->user_id()); |
---|
| 553 | } |
---|
| 554 | my %filter = map {($_, 1)} @userlist; |
---|
| 555 | @branches = grep { |
---|
| 556 | $filter{Fcm::CmBranch->new(URL => $_)->branch_owner()} |
---|
| 557 | } @branches |
---|
| 558 | } |
---|
| 559 | |
---|
| 560 | # Output, number of branches found |
---|
| 561 | $CLI_MESSAGE->( |
---|
| 562 | 'BRANCH_LIST', |
---|
| 563 | $url->project_url_peg(), |
---|
| 564 | $rev ? "r$rev" : 'HEAD', |
---|
| 565 | scalar(@branches), |
---|
| 566 | ($show_all ? '[--show-all]' : join(q{, }, sort(@userlist))), |
---|
| 567 | ); |
---|
| 568 | |
---|
| 569 | if (@branches) { |
---|
| 570 | # Output the URL of each branch |
---|
| 571 | if (not $verbose) { |
---|
| 572 | my $project = $url->project_url; |
---|
| 573 | @branches = map {Fcm::Keyword::unexpand($_)} @branches; |
---|
| 574 | } |
---|
| 575 | @branches = map {$_ . "\n"} sort @branches; |
---|
| 576 | $CLI_MESSAGE->(q{}, join(q{}, @branches)); |
---|
| 577 | |
---|
| 578 | } else { |
---|
| 579 | # No branch found, exit with an error code |
---|
| 580 | return; |
---|
| 581 | } |
---|
| 582 | |
---|
| 583 | } else { |
---|
| 584 | # The option --info or --delete is specified |
---|
| 585 | # Report branch information (and/or delete a branch) |
---|
| 586 | # -------------------------------------------------------------------------- |
---|
| 587 | # Set verbose level |
---|
| 588 | Fcm::Config->instance()->verbose ($verbose ? 1 : 0); |
---|
| 589 | |
---|
| 590 | # Set up the branch, report any error |
---|
| 591 | my $branch = Fcm::CmBranch->new (URL => $url->url_peg); |
---|
| 592 | if (!$branch->branch()) { |
---|
| 593 | return _cm_err(Fcm::Cm::Exception->INVALID_BRANCH, $branch->url_peg()); |
---|
| 594 | } |
---|
| 595 | if (!$branch->url_exists()) { |
---|
| 596 | return _cm_err(Fcm::Cm::Exception->NOT_EXIST, $branch->url_peg()); |
---|
| 597 | } |
---|
| 598 | |
---|
| 599 | # Remove the sub-directory part of the URL |
---|
| 600 | $branch->subdir (''); |
---|
| 601 | |
---|
| 602 | # Report branch info |
---|
| 603 | $branch->display_info ( |
---|
| 604 | SHOW_CHILDREN => ($show_all || $show_children), |
---|
| 605 | SHOW_OTHER => ($show_all || $show_other ), |
---|
| 606 | SHOW_SIBLINGS => ($show_all || $show_siblings), |
---|
| 607 | ); |
---|
| 608 | |
---|
| 609 | # Delete branch if --delete is specified |
---|
| 610 | $branch->del ( |
---|
| 611 | PASSWORD => $password, |
---|
| 612 | NON_INTERACTIVE => $non_interactive, |
---|
| 613 | SVN_NON_INTERACTIVE => $svn_non_interactive, |
---|
| 614 | ) if $delete; |
---|
| 615 | } |
---|
| 616 | |
---|
| 617 | } |
---|
| 618 | |
---|
| 619 | # ------------------------------------------------------------------------------ |
---|
| 620 | # SYNOPSIS |
---|
| 621 | # &Fcm::Cm::cm_commit (); |
---|
| 622 | # |
---|
| 623 | # DESCRIPTION |
---|
| 624 | # This is a FCM wrapper to the "svn commit" command. |
---|
| 625 | # ------------------------------------------------------------------------------ |
---|
| 626 | |
---|
| 627 | sub cm_commit { |
---|
| 628 | my ($dry_run, $svn_non_interactive, $password); |
---|
| 629 | my $rc = GetOptions( |
---|
| 630 | 'dry-run' => \$dry_run, |
---|
| 631 | 'svn-non-interactive' => \$svn_non_interactive, |
---|
| 632 | 'password=s' => \$password, |
---|
| 633 | ); |
---|
| 634 | if (!$rc) { |
---|
| 635 | _cli_err(); |
---|
| 636 | } |
---|
| 637 | |
---|
| 638 | # The remaining argument is the path to a working copy |
---|
| 639 | my ($path) = @ARGV; |
---|
| 640 | |
---|
| 641 | if ($path) { |
---|
| 642 | if (!-e $path) { |
---|
| 643 | return _cm_err(Fcm::Cm::Exception->NOT_EXIST, $path); |
---|
| 644 | } |
---|
| 645 | |
---|
| 646 | } else { |
---|
| 647 | # No argument specified, use current working directory |
---|
| 648 | $path = cwd (); |
---|
| 649 | } |
---|
| 650 | |
---|
| 651 | # Make sure we are in a working copy |
---|
| 652 | if (!is_wc($path)) { |
---|
| 653 | return _cm_err(Fcm::Cm::Exception->INVALID_WC, $path); |
---|
| 654 | } |
---|
| 655 | |
---|
| 656 | # Make sure we are at the top level of the working copy |
---|
| 657 | # (otherwise we might miss any template commit message) |
---|
| 658 | my $dir = &get_wct ($path); |
---|
| 659 | |
---|
| 660 | if ($dir ne cwd ()) { |
---|
| 661 | chdir($dir) || return _cm_err(Fcm::Cm::Exception->CHDIR, $dir); |
---|
| 662 | $CLI_MESSAGE->('CHDIR_WCT', $dir); |
---|
| 663 | } |
---|
| 664 | |
---|
| 665 | # Get update status of working copy |
---|
| 666 | # Check working copy files are not in conflict, missing, or out of date |
---|
| 667 | my @status = _svn_status_get([], 1); |
---|
| 668 | unless (defined $dry_run) { |
---|
| 669 | my (@conflict, @missing, @outdate); |
---|
| 670 | |
---|
| 671 | for (@status) { |
---|
| 672 | if (/^C/) { |
---|
| 673 | push @conflict, $_; |
---|
| 674 | next; |
---|
| 675 | } |
---|
| 676 | |
---|
| 677 | if (/^!/) { |
---|
| 678 | push @missing, $_; |
---|
| 679 | next; |
---|
| 680 | } |
---|
| 681 | |
---|
| 682 | if (/^.{7}\*/) { |
---|
| 683 | push @outdate, $_; |
---|
| 684 | next; |
---|
| 685 | } |
---|
| 686 | |
---|
| 687 | # Check that all files which have been added have the svn:executable |
---|
| 688 | # property set correctly (in case the developer adds a script before they |
---|
| 689 | # remember to set the execute bit) |
---|
| 690 | next unless /^A.{7} *\d+ +(.*)/; |
---|
| 691 | my $file = $1; |
---|
| 692 | |
---|
| 693 | next unless -f $file; |
---|
| 694 | my ($command, @arguments) |
---|
| 695 | = (-x $file && !-l $file) ? ('propset', '*') : ('propdel'); |
---|
| 696 | run_command(['svn', $command, qw{-q svn:executable}, @arguments, $file]); |
---|
| 697 | } |
---|
| 698 | |
---|
| 699 | # Abort commit if files are in conflict, missing, or out of date |
---|
| 700 | if (@conflict or @missing or @outdate) { |
---|
| 701 | for ( |
---|
| 702 | ['ST_CONFLICT' , \@conflict], |
---|
| 703 | ['ST_MISSING' , \@missing ], |
---|
| 704 | ['ST_OUT_OF_DATE', \@outdate ], |
---|
| 705 | ) { |
---|
| 706 | my ($key, $array_ref) = @{$_}; |
---|
| 707 | if (@{$array_ref}) { |
---|
| 708 | $CLI_MESSAGE->($key, join(q{}, @{$array_ref})); |
---|
| 709 | } |
---|
| 710 | } |
---|
| 711 | return _cm_abort(Fcm::Cm::Abort->FAIL); |
---|
| 712 | } |
---|
| 713 | } |
---|
| 714 | |
---|
| 715 | # Read in any existing message |
---|
| 716 | my $ci_mesg = Fcm::CmCommitMessage->new; |
---|
| 717 | $ci_mesg->read_file; |
---|
| 718 | |
---|
| 719 | # Execute "svn status" for a list of changed items |
---|
| 720 | @status = grep !/^\?/, _svn_status_get(); |
---|
| 721 | |
---|
| 722 | # Abort if there is no change in the working copy |
---|
| 723 | if (!@status) { |
---|
| 724 | return _cm_abort(Fcm::Cm::Abort->NULL); |
---|
| 725 | } |
---|
| 726 | |
---|
| 727 | # Get associated URL of current working copy |
---|
| 728 | my $url = Fcm::CmUrl->new (URL => &get_url_of_wc ()); |
---|
| 729 | |
---|
| 730 | # Include URL, or project, branch and sub-directory info in @status |
---|
| 731 | unshift @status, "\n"; |
---|
| 732 | |
---|
| 733 | if ($url->project and $url->branch) { |
---|
| 734 | unshift @status, ( |
---|
| 735 | '[Project: ' . $url->project . ']' . "\n", |
---|
| 736 | '[Branch : ' . $url->branch . ']' . "\n", |
---|
| 737 | '[Sub-dir: ' . ($url->subdir ? $url->subdir : '<top>') . ']' . "\n", |
---|
| 738 | ); |
---|
| 739 | |
---|
| 740 | } else { |
---|
| 741 | unshift @status, '[URL: ' . $url->url . ']' . "\n"; |
---|
| 742 | } |
---|
| 743 | |
---|
| 744 | # Use a temporary file to store the final commit log message |
---|
| 745 | $ci_mesg->ignore_mesg (\@status); |
---|
| 746 | my $logfile = $ci_mesg->edit_file (TEMP => 1); |
---|
| 747 | |
---|
| 748 | # Check with the user to see if he/she wants to go ahead |
---|
| 749 | my $reply = 'n'; |
---|
| 750 | if (!defined($dry_run)) { |
---|
| 751 | # Add extra warning for trunk commit |
---|
| 752 | my @prompt_args; |
---|
| 753 | my $user = Fcm::Config->instance()->user_id(); |
---|
| 754 | |
---|
| 755 | if ($url->is_trunk()) { |
---|
| 756 | @prompt_args = ('CI_TRUNK'); |
---|
| 757 | } |
---|
| 758 | elsif ($user && $url->is_branch() && $url->branch_owner() ne $user) { |
---|
| 759 | if (exists $Fcm::CmUrl::owner_keywords{$url->branch_owner}) { |
---|
| 760 | @prompt_args = ( |
---|
| 761 | 'CI_BRANCH_SHARED', |
---|
| 762 | uc($Fcm::CmUrl::owner_keywords{$url->branch_owner()}), |
---|
| 763 | ); |
---|
| 764 | } |
---|
| 765 | else { |
---|
| 766 | @prompt_args = ('CI_BRANCH_USER'); |
---|
| 767 | } |
---|
| 768 | } |
---|
| 769 | else { |
---|
| 770 | @prompt_args = ('CI'); |
---|
| 771 | } |
---|
| 772 | $reply = $CLI_PROMPT->('commit', @prompt_args); |
---|
| 773 | } |
---|
| 774 | |
---|
| 775 | if ($reply eq 'y') { |
---|
| 776 | # Commit the change if user replies "y" for "yes" |
---|
| 777 | my @command = ( |
---|
| 778 | qw/svn commit -F/, $logfile, |
---|
| 779 | ($svn_non_interactive ? '--non-interactive' : ()), |
---|
| 780 | (defined $password ? ('--password', $password) : ()), |
---|
| 781 | ); |
---|
| 782 | my $rc; |
---|
| 783 | &run_command (\@command, RC => \$rc, ERROR => 'warn'); |
---|
| 784 | |
---|
| 785 | if ($rc) { |
---|
| 786 | # Commit failed |
---|
| 787 | # Write temporary commit log content to commit log message file |
---|
| 788 | $ci_mesg->write_file; |
---|
| 789 | |
---|
| 790 | # Fail the command |
---|
| 791 | return _cm_abort(Fcm::Cm::Abort->FAIL); |
---|
| 792 | } |
---|
| 793 | |
---|
| 794 | # Remove commit message file |
---|
| 795 | unlink $ci_mesg->file; |
---|
| 796 | |
---|
| 797 | # Update the working copy |
---|
| 798 | $CLI_MESSAGE->(q{}, join(q{}, _svn_update())); |
---|
| 799 | |
---|
| 800 | } else { |
---|
| 801 | $ci_mesg->write_file; |
---|
| 802 | if (!$dry_run) { |
---|
| 803 | return _cm_abort(); |
---|
| 804 | } |
---|
| 805 | } |
---|
| 806 | |
---|
| 807 | return; |
---|
| 808 | } |
---|
| 809 | |
---|
| 810 | # ------------------------------------------------------------------------------ |
---|
| 811 | # SYNOPSIS |
---|
| 812 | # &Fcm::Cm::cm_conflicts (); |
---|
| 813 | # |
---|
| 814 | # DESCRIPTION |
---|
| 815 | # This is a FCM command for resolving conflicts within working copy using a |
---|
| 816 | # graphical merge tool. |
---|
| 817 | # ------------------------------------------------------------------------------ |
---|
| 818 | |
---|
| 819 | sub cm_conflicts { |
---|
| 820 | # Path to the working copy |
---|
| 821 | my $path = $ARGV[0]; |
---|
| 822 | $path = cwd () if not $path; |
---|
| 823 | |
---|
| 824 | # Check for any files with conflicts |
---|
| 825 | my @status = grep /^C.{4} *(.*)/, &run_command ( |
---|
| 826 | [qw/svn st/, ($path eq cwd () ? () : $path)], METHOD => 'qx', |
---|
| 827 | ); |
---|
| 828 | my @files = map {m/^C.{4} *(.*)/; $1} @status; |
---|
| 829 | |
---|
| 830 | # Save current working directory |
---|
| 831 | my $topdir = cwd (); |
---|
| 832 | |
---|
| 833 | # Set up environment for graphical merge |
---|
| 834 | # Use environment variable if set, otherwise use default setting |
---|
| 835 | local(%ENV) = %ENV; |
---|
| 836 | $ENV{FCM_GRAPHIC_MERGE} |
---|
| 837 | ||= Fcm::Config->instance()->setting (qw/TOOL GRAPHIC_MERGE/); |
---|
| 838 | |
---|
| 839 | FILE: |
---|
| 840 | for my $file (@files) { |
---|
| 841 | # Print name of file in conflicts |
---|
| 842 | $CLI_MESSAGE->('CF', $file); |
---|
| 843 | |
---|
| 844 | # Determine directory and base name of file in conflicts |
---|
| 845 | my $base = basename $file; |
---|
| 846 | my $dir = dirname $file; |
---|
| 847 | |
---|
| 848 | # Change to container directory of file in conflicts |
---|
| 849 | chdir(File::Spec->catfile($topdir, $dir)) |
---|
| 850 | || return _cm_err(Fcm::Cm::Exception->CHDIR, $dir); |
---|
| 851 | |
---|
| 852 | # Use "svn info" to determine conflict marker files |
---|
| 853 | my @info = &run_command ([qw/svn info/, $base], METHOD => 'qx'); |
---|
| 854 | |
---|
| 855 | # Ignore if $base is a binary file |
---|
| 856 | if (-B $base) { |
---|
| 857 | $CLI_MESSAGE->('CF_BINARY', $base); |
---|
| 858 | next FILE; |
---|
| 859 | } |
---|
| 860 | |
---|
| 861 | # Get conflicts markers files |
---|
| 862 | my ($older, $mine, $yours); |
---|
| 863 | |
---|
| 864 | for (@info) { |
---|
| 865 | $older = $1 if (/^Conflict Previous Base File: (.*)/); |
---|
| 866 | $mine = $1 if (/^Conflict Previous Working File: (.*)/); |
---|
| 867 | $yours = $1 if (/^Conflict Current Base File: (.*)/); |
---|
| 868 | } |
---|
| 869 | |
---|
| 870 | if (-f $base and (stat $base)[9] > (stat $mine)[9] + 1) { |
---|
| 871 | # If $base is newer (by more than a second), it may contain saved changes |
---|
| 872 | if ($CLI_PROMPT->('conflicts', 'CF_OVERWRITE', $base) ne 'y') { |
---|
| 873 | next FILE; |
---|
| 874 | } |
---|
| 875 | } |
---|
| 876 | |
---|
| 877 | # Launch graphic merge tool |
---|
| 878 | my $rc; |
---|
| 879 | my $command = [qw/fcm_graphic_merge/, $base, $mine, $older, $yours]; |
---|
| 880 | # $rc == 0: all conflicts resovled |
---|
| 881 | # $rc == 1: some conflicts not resolved |
---|
| 882 | # $rc == 2: trouble |
---|
| 883 | eval { |
---|
| 884 | run_command($command, RC => \$rc); |
---|
| 885 | }; |
---|
| 886 | if ($@) { |
---|
| 887 | if (!defined($rc) || $rc > 1) { |
---|
| 888 | die($@); |
---|
| 889 | } |
---|
| 890 | } |
---|
| 891 | next FILE if $rc; |
---|
| 892 | |
---|
| 893 | # Prompt user to run "svn resolved" on the file |
---|
| 894 | if ($CLI_PROMPT->('conflicts', 'RUN_SVN_COMMAND', 'resolved') eq 'y') { |
---|
| 895 | run_command([qw{svn resolved}, $base]); |
---|
| 896 | } |
---|
| 897 | } |
---|
| 898 | } |
---|
| 899 | |
---|
| 900 | # ------------------------------------------------------------------------------ |
---|
| 901 | # SYNOPSIS |
---|
| 902 | # &Fcm::Cm::cm_diff (); |
---|
| 903 | # |
---|
| 904 | # DESCRIPTION |
---|
| 905 | # This is a wrapper to "svn diff". It adds two extra functionalities. The |
---|
| 906 | # first one allows the command to show differences relative to the base of |
---|
| 907 | # the branch. The second one allows differences to be displayed via a |
---|
| 908 | # graphical tool. |
---|
| 909 | # ------------------------------------------------------------------------------ |
---|
| 910 | |
---|
| 911 | sub cm_diff { |
---|
| 912 | # Set up environment for graphical diff |
---|
| 913 | # Use environment variable if set, otherwise use default setting |
---|
| 914 | local(%ENV) = %ENV; |
---|
| 915 | $ENV{FCM_GRAPHIC_DIFF} |
---|
| 916 | ||= Fcm::Config->instance()->setting(qw/TOOL GRAPHIC_DIFF/); |
---|
| 917 | |
---|
| 918 | # Check for the --branch options |
---|
| 919 | # ---------------------------------------------------------------------------- |
---|
| 920 | my $branch = grep {$_ eq '-b' or $_ eq '--branch'} @ARGV; |
---|
| 921 | |
---|
| 922 | if (not $branch) { |
---|
| 923 | # The --branch option not specified, just call "svn diff" |
---|
| 924 | # Convert the --graphical to qw/--diff-cmd fcm_graphical_diff/ |
---|
| 925 | # Convert the --summarise to --summarize |
---|
| 926 | @ARGV = map { |
---|
| 927 | my @return; |
---|
| 928 | if ($_ eq '-g' or $_ eq '--graphical') { |
---|
| 929 | @return = (qw/--diff-cmd fcm_graphic_diff/) |
---|
| 930 | |
---|
| 931 | } elsif ($_ eq '--summarise') { |
---|
| 932 | @return = ('--summarize'); |
---|
| 933 | |
---|
| 934 | } else { |
---|
| 935 | @return = ($_); |
---|
| 936 | } |
---|
| 937 | @return; |
---|
| 938 | } @ARGV; |
---|
| 939 | |
---|
| 940 | # Execute the command |
---|
| 941 | return _svn('diff', @ARGV); |
---|
| 942 | } |
---|
| 943 | |
---|
| 944 | # The --branch option is specified |
---|
| 945 | # ---------------------------------------------------------------------------- |
---|
| 946 | |
---|
| 947 | # Determine whether the --graphical option is specified, |
---|
| 948 | # if so set the appropriate command |
---|
| 949 | # ---------------------------------------------------------------------------- |
---|
| 950 | my ($diff_cmd, $extensions, $graphical, $summarise, $trac, $wiki); |
---|
| 951 | my $rc = GetOptions ( |
---|
| 952 | 'b|branch' => \$branch, |
---|
| 953 | 'diff-cmd=s' => \$diff_cmd, |
---|
| 954 | 'x|extensions=s' => \$extensions, |
---|
| 955 | 'g|graphical' => \$graphical, |
---|
| 956 | 'summarise|summarize' => \$summarise, |
---|
| 957 | 't|trac' => \$trac, |
---|
| 958 | 'wiki' => \$wiki, |
---|
| 959 | ); |
---|
| 960 | if (!$rc) { |
---|
| 961 | _cli_err(); |
---|
| 962 | } |
---|
| 963 | |
---|
| 964 | my @diff_cmd = (); |
---|
| 965 | |
---|
| 966 | if ($graphical) { |
---|
| 967 | @diff_cmd = (qw/--diff-cmd fcm_graphic_diff/); |
---|
| 968 | |
---|
| 969 | } elsif ($diff_cmd) { |
---|
| 970 | @diff_cmd = ('--diff-cmd', $diff_cmd); |
---|
| 971 | |
---|
| 972 | push @diff_cmd, '--extensions', split (/\s+/, $extensions) if $extensions; |
---|
| 973 | } |
---|
| 974 | |
---|
| 975 | # The remaining argument should either be a URL or a PATH |
---|
| 976 | my ($url_arg, $path_arg); |
---|
| 977 | |
---|
| 978 | if (@ARGV) { |
---|
| 979 | my $arg = Fcm::CmUrl->new (URL => $ARGV[0]); |
---|
| 980 | |
---|
| 981 | if ($arg->is_url) { |
---|
| 982 | $url_arg = $ARGV[0]; |
---|
| 983 | |
---|
| 984 | } else { |
---|
| 985 | $path_arg = $ARGV[0]; |
---|
| 986 | } |
---|
| 987 | } |
---|
| 988 | |
---|
| 989 | # Get repository and branch information |
---|
| 990 | # ---------------------------------------------------------------------------- |
---|
| 991 | my ($url, $path); |
---|
| 992 | if (defined $url_arg) { |
---|
| 993 | # If a URL is specified, get repository and branch information from it |
---|
| 994 | $url = Fcm::CmBranch->new (URL => $url_arg); |
---|
| 995 | |
---|
| 996 | } else { |
---|
| 997 | # Get repository and branch information from the specified path or the |
---|
| 998 | # current directory if it is a working copy |
---|
| 999 | $path = $path_arg ? $path_arg : cwd (); |
---|
| 1000 | if (!is_wc($path)) { |
---|
| 1001 | return _cm_err(Fcm::Cm::Exception->INVALID_WC, $path); |
---|
| 1002 | } |
---|
| 1003 | |
---|
| 1004 | $url = Fcm::CmBranch->new (URL => &get_url_peg_of_wc ($path)); |
---|
| 1005 | } |
---|
| 1006 | |
---|
| 1007 | # Check that URL is a standard FCM branch |
---|
| 1008 | if (!$url->is_branch()) { |
---|
| 1009 | return _cm_err(Fcm::Cm::Exception->INVALID_BRANCH, $url->url_peg()); |
---|
| 1010 | } |
---|
| 1011 | |
---|
| 1012 | # Save and remove sub-directory part of the URL |
---|
| 1013 | my $subdir = $url->subdir (); |
---|
| 1014 | $url->subdir (''); |
---|
| 1015 | |
---|
| 1016 | # Check that $url exists |
---|
| 1017 | if (!$url->url_exists()) { |
---|
| 1018 | return _cm_err(Fcm::Cm::Exception->INVALID_URL, $url->url_peg()); |
---|
| 1019 | } |
---|
| 1020 | |
---|
| 1021 | # Compare current branch with its parent |
---|
| 1022 | # ---------------------------------------------------------------------------- |
---|
| 1023 | my $parent = Fcm::CmBranch->new (URL => $url->parent->url); |
---|
| 1024 | $parent->pegrev ($url->pegrev) if $url->pegrev; |
---|
| 1025 | |
---|
| 1026 | if (!$parent->url_exists()) { |
---|
| 1027 | return _cm_err( |
---|
| 1028 | Fcm::Cm::Exception->PARENT_NOT_EXIST, $url->url_peg(), $parent->url(), |
---|
| 1029 | ); |
---|
| 1030 | } |
---|
| 1031 | |
---|
| 1032 | my $base = $parent->base_of_merge_from ($url); |
---|
| 1033 | |
---|
| 1034 | # Ensure the correct diff (syntax) is displayed |
---|
| 1035 | # ---------------------------------------------------------------------------- |
---|
| 1036 | # Reinstate the sub-tree part into the URL |
---|
| 1037 | $url->subdir ($subdir); |
---|
| 1038 | $base->subdir ($subdir); |
---|
| 1039 | |
---|
| 1040 | # Ensure the branch URL has a peg revision |
---|
| 1041 | $url->pegrev ($url->svninfo (FLAG => 'Last Changed Rev')) if not $url->pegrev; |
---|
| 1042 | |
---|
| 1043 | if ($trac or $wiki) { |
---|
| 1044 | # Trac/wiki |
---|
| 1045 | # -------------------------------------------------------------------------- |
---|
| 1046 | if (!$url_arg && _svn_status_get([$path_arg ? $path_arg : q{.}])) { |
---|
| 1047 | $CLI_MESSAGE->('ST_IN_TRAC_DIFF', ($path_arg ? $path_arg : q{.})); |
---|
| 1048 | } |
---|
| 1049 | |
---|
| 1050 | # Trac wiki syntax |
---|
| 1051 | my $wiki_syntax = 'diff:' . $base->path_peg . '//' . $url->path_peg; |
---|
| 1052 | |
---|
| 1053 | if ($wiki) { |
---|
| 1054 | # Print Trac wiki syntax only |
---|
| 1055 | $CLI_MESSAGE->(q{}, "$wiki_syntax\n"); |
---|
| 1056 | |
---|
| 1057 | } else { # if $trac |
---|
| 1058 | # Use Trac to view "diff" |
---|
| 1059 | my $browser = Fcm::Config->instance()->setting(qw/WEB_BROWSER/); |
---|
| 1060 | $browser ||= 'firefox'; |
---|
| 1061 | |
---|
| 1062 | my $trac_url = Fcm::Keyword::get_browser_url($url->project_url()); |
---|
| 1063 | $trac_url =~ s{/intertrac/.*$}{/intertrac/$wiki_syntax}xms; |
---|
| 1064 | |
---|
| 1065 | &run_command ([$browser, $trac_url], METHOD => 'exec', PRINT => 1); |
---|
| 1066 | } |
---|
| 1067 | |
---|
| 1068 | } else { |
---|
| 1069 | # Execute the "diff" command |
---|
| 1070 | # -------------------------------------------------------------------------- |
---|
| 1071 | my @command = ( |
---|
| 1072 | qw/svn diff/, @diff_cmd, |
---|
| 1073 | ($summarise ? ('--summarize') : ()), |
---|
| 1074 | '--old', $base->url_peg, |
---|
| 1075 | '--new', ($url_arg ? $url->url_peg : ($path_arg ? $path_arg : '.')), |
---|
| 1076 | ); |
---|
| 1077 | &run_command (\@command, PRINT => 1); |
---|
| 1078 | } |
---|
| 1079 | } |
---|
| 1080 | |
---|
| 1081 | # ------------------------------------------------------------------------------ |
---|
| 1082 | # SYNOPSIS |
---|
| 1083 | # &Fcm::Cm::cm_merge (); |
---|
| 1084 | # |
---|
| 1085 | # DESCRIPTION |
---|
| 1086 | # This is a wrapper to "svn merge". |
---|
| 1087 | # ------------------------------------------------------------------------------ |
---|
| 1088 | |
---|
| 1089 | sub cm_merge { |
---|
| 1090 | # Options |
---|
| 1091 | # ---------------------------------------------------------------------------- |
---|
| 1092 | my ($custom, $dry_run, $non_interactive, $reverse, $rev, $verbose); |
---|
| 1093 | my $rc = GetOptions( |
---|
| 1094 | 'custom' => \$custom, |
---|
| 1095 | 'dry-run' => \$dry_run, |
---|
| 1096 | 'non-interactive' => \$non_interactive, |
---|
| 1097 | 'reverse' => \$reverse, |
---|
| 1098 | 'revision|r=s' => \$rev, |
---|
| 1099 | 'verbose|v' => \$verbose, |
---|
| 1100 | ); |
---|
| 1101 | if (!$rc) { |
---|
| 1102 | _cli_err(); |
---|
| 1103 | } |
---|
| 1104 | |
---|
| 1105 | # Find out the URL of the working copy |
---|
| 1106 | # ---------------------------------------------------------------------------- |
---|
| 1107 | my ($target, $wct); |
---|
| 1108 | if (&is_wc ()) { |
---|
| 1109 | $wct = &get_wct (); |
---|
| 1110 | |
---|
| 1111 | if ($wct ne cwd ()) { |
---|
| 1112 | chdir($wct) || return _cm_err(Fcm::Cm::Exception->CHDIR, $wct); |
---|
| 1113 | $CLI_MESSAGE->('CHDIR_WCT', $wct); |
---|
| 1114 | } |
---|
| 1115 | |
---|
| 1116 | $target = Fcm::CmBranch->new (URL => &get_url_of_wc ($wct)); |
---|
| 1117 | |
---|
| 1118 | } else { |
---|
| 1119 | return _cm_err(Fcm::Cm::Exception->INVALID_WC, '.'); |
---|
| 1120 | } |
---|
| 1121 | |
---|
| 1122 | if (!$target->url_exists()) { |
---|
| 1123 | return _cm_err(Fcm::Cm::Exception->WC_URL_NOT_EXIST, '.'); |
---|
| 1124 | } |
---|
| 1125 | |
---|
| 1126 | # The target must be at the top of a branch |
---|
| 1127 | # $subdir will be used later to determine whether the merge is allowed or not |
---|
| 1128 | my $subdir = $target->subdir; |
---|
| 1129 | $target->subdir ('') if $subdir; |
---|
| 1130 | |
---|
| 1131 | # Check for any local modifications |
---|
| 1132 | # ---------------------------------------------------------------------------- |
---|
| 1133 | if (!$dry_run && !$non_interactive) { |
---|
| 1134 | _svn_status_checker('merge', 'MODIFIED', $CLI_HANDLER_OF{WC_STATUS})->(); |
---|
| 1135 | } |
---|
| 1136 | |
---|
| 1137 | # Determine the SOURCE URL |
---|
| 1138 | # ---------------------------------------------------------------------------- |
---|
| 1139 | my $source; |
---|
| 1140 | |
---|
| 1141 | if ($reverse) { |
---|
| 1142 | # Reverse merge, the SOURCE is the the working copy URL |
---|
| 1143 | $source = Fcm::CmBranch->new (URL => $target->url); |
---|
| 1144 | |
---|
| 1145 | } else { |
---|
| 1146 | # Automatic/custom merge, argument 1 is the SOURCE of the merge |
---|
| 1147 | my $source_url = shift (@ARGV); |
---|
| 1148 | if (!$source_url) { |
---|
| 1149 | _cli_err('CLI_MERGE_ARG1'); |
---|
| 1150 | } |
---|
| 1151 | |
---|
| 1152 | $source = _cm_get_source($source_url, $target); |
---|
| 1153 | } |
---|
| 1154 | |
---|
| 1155 | # Parse the revision option |
---|
| 1156 | # ---------------------------------------------------------------------------- |
---|
| 1157 | if ($reverse && !$rev) { |
---|
| 1158 | _cli_err('CLI_OPT_WITH_OPT', 'revision', 'reverse'); |
---|
| 1159 | } |
---|
| 1160 | my @revs = (($reverse || $custom) && $rev ? split(qr{:}xms, $rev) : ()); |
---|
| 1161 | |
---|
| 1162 | # Determine the merge delta and the commit log message |
---|
| 1163 | # ---------------------------------------------------------------------------- |
---|
| 1164 | my (@delta, $mesg); |
---|
| 1165 | my $separator = '-' x 80 . "\n"; |
---|
| 1166 | |
---|
| 1167 | if ($reverse) { |
---|
| 1168 | # Reverse merge |
---|
| 1169 | # -------------------------------------------------------------------------- |
---|
| 1170 | if (@revs == 1) { |
---|
| 1171 | $revs[1] = ($revs[0] - 1); |
---|
| 1172 | |
---|
| 1173 | } else { |
---|
| 1174 | @revs = sort {$b <=> $a} @revs; |
---|
| 1175 | } |
---|
| 1176 | |
---|
| 1177 | $source->pegrev ($source->svninfo (FLAG => 'Last Changed Rev')) |
---|
| 1178 | unless $source->pegrev; |
---|
| 1179 | $source->subdir ($subdir); |
---|
| 1180 | |
---|
| 1181 | # "Delta" of the "svn merge" command |
---|
| 1182 | @delta = ('-r' . $revs[0] . ':' . $revs[1], $source->url_peg); |
---|
| 1183 | |
---|
| 1184 | # Template message |
---|
| 1185 | $mesg = 'Reversed r' . $revs[0] . |
---|
| 1186 | (($revs[1] < $revs[0] - 1) ? ':' . $revs[1] : '') . ' of ' . |
---|
| 1187 | $source->path . "\n"; |
---|
| 1188 | |
---|
| 1189 | } elsif ($custom) { |
---|
| 1190 | # Custom merge |
---|
| 1191 | # -------------------------------------------------------------------------- |
---|
| 1192 | if (@revs) { |
---|
| 1193 | # Revision specified |
---|
| 1194 | # ------------------------------------------------------------------------ |
---|
| 1195 | # Only one revision N specified, use (N - 1):N as the delta |
---|
| 1196 | unshift @revs, ($revs[0] - 1) if @revs == 1; |
---|
| 1197 | |
---|
| 1198 | $source->pegrev ($source->svninfo (FLAG => 'Last Changed Rev')) |
---|
| 1199 | unless $source->pegrev; |
---|
| 1200 | $source->subdir ($subdir); |
---|
| 1201 | $target->subdir ($subdir); |
---|
| 1202 | |
---|
| 1203 | # "Delta" of the "svn merge" command |
---|
| 1204 | @delta = ('-r' . $revs[0] . ':' . $revs[1], $source->url_peg); |
---|
| 1205 | |
---|
| 1206 | # Template message |
---|
| 1207 | $mesg = 'Custom merge into ' . $target->path . ': r' . $revs[1] . |
---|
| 1208 | ' cf. r' . $revs[0] . ' of ' . $source->path_peg . "\n"; |
---|
| 1209 | |
---|
| 1210 | } else { |
---|
| 1211 | # Revision not specified |
---|
| 1212 | # ------------------------------------------------------------------------ |
---|
| 1213 | # Get second source URL |
---|
| 1214 | my $source2_url = shift (@ARGV); |
---|
| 1215 | if (!$source2_url) { |
---|
| 1216 | _cli_err('CLI_MERGE_ARG2'); |
---|
| 1217 | } |
---|
| 1218 | |
---|
| 1219 | my $source2 = _cm_get_source($source2_url, $target); |
---|
| 1220 | |
---|
| 1221 | $source->pegrev ($source->svninfo (FLAG => 'Last Changed Rev')) |
---|
| 1222 | unless $source->pegrev; |
---|
| 1223 | $source2->pegrev ($source2->svninfo (FLAG => 'Last Changed Rev')) |
---|
| 1224 | unless $source2->pegrev; |
---|
| 1225 | $source->subdir ($subdir); |
---|
| 1226 | $source2->subdir ($subdir); |
---|
| 1227 | $target->subdir ($subdir); |
---|
| 1228 | |
---|
| 1229 | # "Delta" of the "svn merge" command |
---|
| 1230 | @delta = ($source->url_peg, $source2->url_peg); |
---|
| 1231 | |
---|
| 1232 | # Template message |
---|
| 1233 | $mesg = 'Custom merge into ' . $target->path . ': ' . $source->path_peg . |
---|
| 1234 | ' cf. ' . $source2->path_peg . "\n"; |
---|
| 1235 | } |
---|
| 1236 | |
---|
| 1237 | } else { |
---|
| 1238 | # Automatic merge |
---|
| 1239 | # -------------------------------------------------------------------------- |
---|
| 1240 | # Check to ensure source branch is not the same as the target branch |
---|
| 1241 | if (!$target->branch()) { |
---|
| 1242 | return _cm_err(Fcm::Cm::Exception->WC_INVALID_BRANCH, $wct); |
---|
| 1243 | } |
---|
| 1244 | if ($source->branch() eq $target->branch()) { |
---|
| 1245 | return _cm_err(Fcm::Cm::Exception->MERGE_SELF, $target->url_peg(), $wct); |
---|
| 1246 | } |
---|
| 1247 | |
---|
| 1248 | # Only allow the merge if the source and target are "directly related" |
---|
| 1249 | # -------------------------------------------------------------------------- |
---|
| 1250 | my $anc = $target->ancestor ($source); |
---|
| 1251 | return _cm_err( |
---|
| 1252 | Fcm::Cm::Exception->MERGE_UNRELATED, $target->url_peg(), $source->url_peg |
---|
| 1253 | ) unless |
---|
| 1254 | ($anc->url eq $target->url and $anc->url_peg eq $source->parent->url_peg) |
---|
| 1255 | or |
---|
| 1256 | ($anc->url eq $source->url and $anc->url_peg eq $target->parent->url_peg) |
---|
| 1257 | or |
---|
| 1258 | ($anc->url eq $source->parent->url and $anc->url eq $target->parent->url); |
---|
| 1259 | |
---|
| 1260 | # Check for available merges from the source |
---|
| 1261 | # -------------------------------------------------------------------------- |
---|
| 1262 | my @revs = $target->avail_merge_from ($source, 1); |
---|
| 1263 | |
---|
| 1264 | if (@revs) { |
---|
| 1265 | if ($verbose) { |
---|
| 1266 | # Verbose mode, print log messages of available merges |
---|
| 1267 | $CLI_MESSAGE->('MERGE_REVS', $source->path_peg(), q{}); |
---|
| 1268 | for (@revs) { |
---|
| 1269 | $CLI_MESSAGE->('SEPARATOR'); |
---|
| 1270 | $CLI_MESSAGE->(q{}, $source->display_svnlog($_)); |
---|
| 1271 | } |
---|
| 1272 | $CLI_MESSAGE->('SEPARATOR'); |
---|
| 1273 | } |
---|
| 1274 | else { |
---|
| 1275 | # Normal mode, list revisions of available merges |
---|
| 1276 | $CLI_MESSAGE->('MERGE_REVS', $source->path_peg(), join(q{ }, @revs)); |
---|
| 1277 | } |
---|
| 1278 | |
---|
| 1279 | } else { |
---|
| 1280 | return _cm_abort(Fcm::Cm::Abort->NULL); |
---|
| 1281 | } |
---|
| 1282 | |
---|
| 1283 | # If more than one merge available, prompt user to enter a revision number |
---|
| 1284 | # to merge from, default to $revs [0] |
---|
| 1285 | # -------------------------------------------------------------------------- |
---|
| 1286 | if ($non_interactive || @revs == 1) { |
---|
| 1287 | $source->pegrev($revs[0]); |
---|
| 1288 | } |
---|
| 1289 | else { |
---|
| 1290 | my $reply = $CLI_PROMPT->( |
---|
| 1291 | {type => q{}, default => $revs[0]}, 'merge', 'MERGE_REV', |
---|
| 1292 | ); |
---|
| 1293 | if (!defined($reply)) { |
---|
| 1294 | return _cm_abort(); |
---|
| 1295 | } |
---|
| 1296 | # Expand revision keyword if necessary |
---|
| 1297 | if ($reply) { |
---|
| 1298 | $reply = (Fcm::Keyword::expand($target->project_url(), $reply))[1]; |
---|
| 1299 | } |
---|
| 1300 | # Check that the reply is a number in the available merges list |
---|
| 1301 | if (!grep {$_ eq $reply} @revs) { |
---|
| 1302 | return _cm_err(Fcm::Cm::Exception->MERGE_REV_INVALID, $reply) |
---|
| 1303 | } |
---|
| 1304 | $source->pegrev($reply); |
---|
| 1305 | } |
---|
| 1306 | |
---|
| 1307 | # If the working copy top is pointing to a sub-directory of a branch, |
---|
| 1308 | # we need to check whether the merge will result in losing changes made in |
---|
| 1309 | # other sub-directories of the source. |
---|
| 1310 | if ($subdir and not $target->allow_subdir_merge_from ($source, $subdir)) { |
---|
| 1311 | return _cm_err(Fcm::Cm::Exception->MERGE_UNSAFE, $source->url_peg()); |
---|
| 1312 | } |
---|
| 1313 | |
---|
| 1314 | # Calculate the base of the merge |
---|
| 1315 | my $base = $target->base_of_merge_from ($source); |
---|
| 1316 | |
---|
| 1317 | # $source and $base must take into account the sub-directory |
---|
| 1318 | my $s = Fcm::CmBranch->new (URL => $source->url_peg); |
---|
| 1319 | my $b = Fcm::CmBranch->new (URL => $base->url_peg); |
---|
| 1320 | |
---|
| 1321 | $s->subdir ($subdir) if $subdir; |
---|
| 1322 | $b->subdir ($subdir) if $subdir; |
---|
| 1323 | |
---|
| 1324 | # Diagnostic |
---|
| 1325 | $CLI_MESSAGE->('MERGE_CF', $s->path_peg(), $b->path_peg()); |
---|
| 1326 | |
---|
| 1327 | # Delta of the "svn merge" command |
---|
| 1328 | @delta = ($b->url_peg, $s->url_peg); |
---|
| 1329 | |
---|
| 1330 | # Template message |
---|
| 1331 | $mesg = 'Merged into ' . $target->path . ': ' . $source->path_peg . |
---|
| 1332 | ' cf. ' . $base->path_peg . "\n"; |
---|
| 1333 | } |
---|
| 1334 | |
---|
| 1335 | # Run "svn merge" in "--dry-run" mode to see the result |
---|
| 1336 | # ---------------------------------------------------------------------------- |
---|
| 1337 | my @out = &run_command ( |
---|
| 1338 | [qw/svn merge --dry-run/, @delta], |
---|
| 1339 | METHOD => 'qx', PRINT => ($dry_run and $verbose), |
---|
| 1340 | ); |
---|
| 1341 | |
---|
| 1342 | # Abort merge if it will result in no change |
---|
| 1343 | if (not @out) { |
---|
| 1344 | return _cm_abort(Fcm::Cm::Abort->NULL); |
---|
| 1345 | } |
---|
| 1346 | |
---|
| 1347 | # Report result of "svn merge --dry-run" |
---|
| 1348 | if ($dry_run || !$non_interactive) { |
---|
| 1349 | $CLI_MESSAGE->('MERGE_DRY'); |
---|
| 1350 | $CLI_MESSAGE->('SEPARATOR'); |
---|
| 1351 | $CLI_MESSAGE->(q{}, join(q{}, @out)); |
---|
| 1352 | $CLI_MESSAGE->('SEPARATOR'); |
---|
| 1353 | } |
---|
| 1354 | |
---|
| 1355 | return if $dry_run; |
---|
| 1356 | |
---|
| 1357 | # Prompt the user to see if (s)he would like to go ahead |
---|
| 1358 | # ---------------------------------------------------------------------------- |
---|
| 1359 | # Go ahead with merge only if user replies "y" |
---|
| 1360 | if (!$non_interactive && $CLI_PROMPT->('merge', 'MERGE') ne 'y') { |
---|
| 1361 | return _cm_abort(); |
---|
| 1362 | } |
---|
| 1363 | $CLI_MESSAGE->('MERGE'); |
---|
| 1364 | run_command([qw/svn merge/, @delta], PRINT => $verbose); |
---|
| 1365 | |
---|
| 1366 | # Prepare the commit log |
---|
| 1367 | # ---------------------------------------------------------------------------- |
---|
| 1368 | # Read in any existing message |
---|
| 1369 | my $ci_mesg = Fcm::CmCommitMessage->new; |
---|
| 1370 | $ci_mesg->read_file; |
---|
| 1371 | $ci_mesg->auto_mesg ([$mesg, @{ $ci_mesg->auto_mesg }]); |
---|
| 1372 | $ci_mesg->write_file; |
---|
| 1373 | |
---|
| 1374 | if ($verbose) { |
---|
| 1375 | $CLI_MESSAGE->('SEPARATOR'); |
---|
| 1376 | $CLI_MESSAGE->('MERGE_CI', $mesg); |
---|
| 1377 | } |
---|
| 1378 | |
---|
| 1379 | return; |
---|
| 1380 | } |
---|
| 1381 | |
---|
| 1382 | # ------------------------------------------------------------------------------ |
---|
| 1383 | # SYNOPSIS |
---|
| 1384 | # &Fcm::Cm::cm_mkpatch (); |
---|
| 1385 | # |
---|
| 1386 | # DESCRIPTION |
---|
| 1387 | # This is a FCM command to create a patching script from particular revisions |
---|
| 1388 | # of a URL. |
---|
| 1389 | # ------------------------------------------------------------------------------ |
---|
| 1390 | |
---|
| 1391 | sub cm_mkpatch { |
---|
| 1392 | # Process command line options and arguments |
---|
| 1393 | # ---------------------------------------------------------------------------- |
---|
| 1394 | my (@exclude, $organisation, $revision); |
---|
| 1395 | my $rc = GetOptions( |
---|
| 1396 | 'exclude=s' => \@exclude, |
---|
| 1397 | 'organisation=s' => \$organisation, |
---|
| 1398 | 'r|revision=s' => \$revision, |
---|
| 1399 | ); |
---|
| 1400 | if (!$rc) { |
---|
| 1401 | _cli_err(); |
---|
| 1402 | } |
---|
| 1403 | |
---|
| 1404 | # Excluded paths, convert glob into regular patterns |
---|
| 1405 | @exclude = split (/:/, join (':', @exclude)); |
---|
| 1406 | for (@exclude) { |
---|
| 1407 | s#\*#[^/]*#; # match any number of non-slash character |
---|
| 1408 | s#\?#[^/]#; # match a non-slash character |
---|
| 1409 | s#/*$##; # remove trailing slash |
---|
| 1410 | } |
---|
| 1411 | |
---|
| 1412 | # Organisation prefix |
---|
| 1413 | $organisation = $organisation ? $organisation : 'original'; |
---|
| 1414 | |
---|
| 1415 | # Make sure revision option is set correctly |
---|
| 1416 | my @revs = $revision ? split (/:/, $revision) : (); |
---|
| 1417 | @revs = @revs [0, 1] if @revs > 2; |
---|
| 1418 | |
---|
| 1419 | # Arguments |
---|
| 1420 | my ($u, $outdir) = @ARGV; |
---|
| 1421 | |
---|
| 1422 | if (!$u) { |
---|
| 1423 | _cli_err(); |
---|
| 1424 | } |
---|
| 1425 | |
---|
| 1426 | my $url = Fcm::CmUrl->new (URL => $u); |
---|
| 1427 | if (!$url->is_url()) { |
---|
| 1428 | return _cm_err(Fcm::Cm::Exception->INVALID_URL, $u); |
---|
| 1429 | } |
---|
| 1430 | if (!$url->url_exists()) { |
---|
| 1431 | return _cm_err(Fcm::Cm::Exception->NOT_EXIST, $u); |
---|
| 1432 | } |
---|
| 1433 | if (!$url->branch()) { |
---|
| 1434 | $CLI_MESSAGE->('INVALID_BRANCH', $u); |
---|
| 1435 | } |
---|
| 1436 | elsif ($url->subdir()) { |
---|
| 1437 | $CLI_MESSAGE->('BRANCH_SUBDIR', $u); |
---|
| 1438 | } |
---|
| 1439 | |
---|
| 1440 | if (@revs) { |
---|
| 1441 | # If HEAD revision is given, convert it into a number |
---|
| 1442 | # -------------------------------------------------------------------------- |
---|
| 1443 | for my $rev (@revs) { |
---|
| 1444 | $rev = $url->svninfo (FLAG => 'Revision') if uc ($rev) eq 'HEAD'; |
---|
| 1445 | } |
---|
| 1446 | |
---|
| 1447 | } else { |
---|
| 1448 | # If no revision is given, use the HEAD |
---|
| 1449 | # -------------------------------------------------------------------------- |
---|
| 1450 | $revs[0] = $url->svninfo (FLAG => 'Revision'); |
---|
| 1451 | } |
---|
| 1452 | |
---|
| 1453 | $revs[1] = $revs[0] if @revs == 1; |
---|
| 1454 | |
---|
| 1455 | # Check that output directory is set |
---|
| 1456 | # ---------------------------------------------------------------------------- |
---|
| 1457 | $outdir = File::Spec->catfile (cwd (), 'fcm-mkpatch-out') if not $outdir; |
---|
| 1458 | |
---|
| 1459 | if (-e $outdir) { |
---|
| 1460 | # Ask user to confirm removal of old output directory if it exists |
---|
| 1461 | if ($CLI_PROMPT->('mkpatch', 'MKPATCH_OVERWRITE') ne 'y') { |
---|
| 1462 | return _cm_abort(); |
---|
| 1463 | } |
---|
| 1464 | |
---|
| 1465 | rmtree($outdir) || return _cm_err(Fcm::Cm::Exception->RMTREE, $outdir); |
---|
| 1466 | } |
---|
| 1467 | |
---|
| 1468 | # (Re-)create output directory |
---|
| 1469 | mkpath($outdir) || return _cm_err(Fcm::Cm::Exception->MKPATH, $outdir); |
---|
| 1470 | $CLI_MESSAGE->('OUT_DIR', $outdir); |
---|
| 1471 | |
---|
| 1472 | # Get and process log of URL |
---|
| 1473 | # ---------------------------------------------------------------------------- |
---|
| 1474 | my @script = (); # main output script |
---|
| 1475 | my %log = $url->svnlog (REV => \@revs); |
---|
| 1476 | my $url_path = $url->path; |
---|
| 1477 | |
---|
| 1478 | for my $rev (sort {$a <=> $b} keys %log) { |
---|
| 1479 | # Look at the changed paths for each revision |
---|
| 1480 | my $use_patch = 1; # OK to use a patch file? |
---|
| 1481 | my @paths; |
---|
| 1482 | PATH: for my $path (sort keys %{ $log{$rev}{paths} }) { |
---|
| 1483 | my $file = $path; |
---|
| 1484 | |
---|
| 1485 | # Skip paths outside of the branch |
---|
| 1486 | next PATH unless $file =~ s#^$url_path/*##; |
---|
| 1487 | |
---|
| 1488 | # Skip excluded paths |
---|
| 1489 | for my $exclude (@exclude) { |
---|
| 1490 | if ($file =~ m#^$exclude(?:/*|$)#) { |
---|
| 1491 | # Can't use a patch file if any files have been excluded |
---|
| 1492 | $use_patch = 0; |
---|
| 1493 | next PATH; |
---|
| 1494 | } |
---|
| 1495 | } |
---|
| 1496 | |
---|
| 1497 | # Can't use a patch file if any files have been added or replaced |
---|
| 1498 | $use_patch = 0 if $log{$rev}{paths}{$path}{action} eq 'A' or |
---|
| 1499 | $log{$rev}{paths}{$path}{action} eq 'R'; |
---|
| 1500 | |
---|
| 1501 | push @paths, $path; |
---|
| 1502 | } |
---|
| 1503 | |
---|
| 1504 | # If a patch is being used, make sure it isn't just property changes |
---|
| 1505 | if ($use_patch) { |
---|
| 1506 | my @changedpaths; |
---|
| 1507 | for my $path (@paths) { |
---|
| 1508 | (my $file = $path) =~ s#^$url_path/*##; |
---|
| 1509 | if ($log{$rev}{paths}{$path}{action} eq 'M') { |
---|
| 1510 | my ($diff) = &run_command ( |
---|
| 1511 | [qw/svn diff --no-diff-deleted --summarize -c/, |
---|
| 1512 | $rev, $url->url . '/' . $file. '@' . $rev], |
---|
| 1513 | METHOD => 'qx'); |
---|
| 1514 | next unless $diff =~ /^[A-Z]/; |
---|
| 1515 | } |
---|
| 1516 | push @changedpaths, $path; |
---|
| 1517 | } |
---|
| 1518 | @paths = @changedpaths; |
---|
| 1519 | } |
---|
| 1520 | |
---|
| 1521 | next unless @paths; |
---|
| 1522 | |
---|
| 1523 | # Create the patch using "svn diff" |
---|
| 1524 | my @patch = (); |
---|
| 1525 | if ($use_patch) { |
---|
| 1526 | @patch = &run_command ([qw/svn diff --no-diff-deleted -c/, $rev, |
---|
| 1527 | $url->url], METHOD => 'qx'); |
---|
| 1528 | if (@patch) { |
---|
| 1529 | # Don't use the patch if it may contain subversion keywords |
---|
| 1530 | for (@patch) { |
---|
| 1531 | $use_patch = 0 if /\$[a-zA-Z:]+ *\$/; |
---|
| 1532 | } |
---|
| 1533 | } else { |
---|
| 1534 | $use_patch = 0; |
---|
| 1535 | } |
---|
| 1536 | } |
---|
| 1537 | |
---|
| 1538 | # Create a directory for this revision in the output directory |
---|
| 1539 | my $outdir_rev = File::Spec->catfile ($outdir, $rev); |
---|
| 1540 | mkpath($outdir_rev) |
---|
| 1541 | || return _cm_err(Fcm::Cm::Exception->MKPATH, $outdir_rev); |
---|
| 1542 | |
---|
| 1543 | # Parse commit log message |
---|
| 1544 | my @msg = split /\n/, $log{$rev}{msg}; |
---|
| 1545 | for (@msg) { |
---|
| 1546 | # Re-instate line break |
---|
| 1547 | $_ .= "\n"; |
---|
| 1548 | |
---|
| 1549 | # Remove line if it matches a merge template |
---|
| 1550 | $_ = '' if /^Reversed r\d+(?::\d+)? of \S+$/; |
---|
| 1551 | $_ = '' if /^Custom merge into \S+:.+$/; |
---|
| 1552 | $_ = '' if /^Merged into \S+: \S+ cf\. \S+$/; |
---|
| 1553 | |
---|
| 1554 | # Modify Trac ticket link |
---|
| 1555 | s/(?:#|ticket:)(\d+)/${organisation}_ticket:$1/g; |
---|
| 1556 | |
---|
| 1557 | # Modify Trac changeset link |
---|
| 1558 | s/(?:r|changeset:)(\d+)/${organisation}_changeset:$1/g; |
---|
| 1559 | s/\[(\d+)\]/${organisation}_changeset:$1/g; |
---|
| 1560 | } |
---|
| 1561 | |
---|
| 1562 | push @msg, '(' . $organisation . '_changeset:' . $rev . ')' . "\n"; |
---|
| 1563 | |
---|
| 1564 | # Write commit log message in a file |
---|
| 1565 | my $f_revlog = File::Spec->catfile ($outdir_rev, 'log-message'); |
---|
| 1566 | open FILE, '>', $f_revlog or die $f_revlog, ': cannot open (', $!, ')'; |
---|
| 1567 | print FILE @msg; |
---|
| 1568 | close FILE or die $f_revlog, ': cannot close (', $!, ')'; |
---|
| 1569 | |
---|
| 1570 | # Handle each changed path |
---|
| 1571 | my $export_file = 1; # name for next exported file (gets incremented) |
---|
| 1572 | my $patch_needed = 0; # is a patch file required? |
---|
| 1573 | my @before_script = (); # patch script to run before patch applied |
---|
| 1574 | my @after_script = (); # patch script to run after patch applied |
---|
| 1575 | my @copied_dirs = (); # copied directories |
---|
| 1576 | CHANGED: for my $path (@paths) { |
---|
| 1577 | (my $file = $path) =~ s#^$url_path/*##; |
---|
| 1578 | my $url_file = $url->url . '/' . $file . '@' . $rev; |
---|
| 1579 | |
---|
| 1580 | # Skip paths within copied directories |
---|
| 1581 | for my $copied_dir (@copied_dirs) { |
---|
| 1582 | next CHANGED if $file =~ m#^$copied_dir(?:/*|$)#; |
---|
| 1583 | } |
---|
| 1584 | |
---|
| 1585 | if ($log{$rev}{paths}{$path}{action} eq 'D') { |
---|
| 1586 | # Script to delete file |
---|
| 1587 | push @after_script, 'svn delete ' . $file; |
---|
| 1588 | |
---|
| 1589 | } else { |
---|
| 1590 | my $export_required = 0; |
---|
| 1591 | my $recursive_add = 0; |
---|
| 1592 | my $is_newfile = 0; |
---|
| 1593 | |
---|
| 1594 | # Skip property changes |
---|
| 1595 | if ($log{$rev}{paths}{$path}{action} eq 'M') { |
---|
| 1596 | my ($diff) = &run_command ( |
---|
| 1597 | [qw/svn diff --no-diff-deleted --summarize -c/, |
---|
| 1598 | $rev, $url->url . '/' . $file. '@' . $rev], |
---|
| 1599 | METHOD => 'qx'); |
---|
| 1600 | next CHANGED unless $diff =~ /^[A-Z]/; |
---|
| 1601 | } |
---|
| 1602 | |
---|
| 1603 | # Determine if the file is a directory |
---|
| 1604 | my $is_dir = 0; |
---|
| 1605 | if ($log{$rev}{paths}{$path}{action} ne 'M') { |
---|
| 1606 | my @info = &run_command ([qw/svn info/, $url_file], METHOD => 'qx'); |
---|
| 1607 | for (@info) { |
---|
| 1608 | if (/^Node Kind: (\w+)/) { |
---|
| 1609 | $is_dir = 1 if $1 eq 'directory'; |
---|
| 1610 | last; |
---|
| 1611 | } |
---|
| 1612 | } |
---|
| 1613 | } |
---|
| 1614 | |
---|
| 1615 | # Decide how to treat added files |
---|
| 1616 | if ($log{$rev}{paths}{$path}{action} eq 'A') { |
---|
| 1617 | # Determine if the file is copied |
---|
| 1618 | if (exists $log{$rev}{paths}{$path}{'copyfrom-path'}) { |
---|
| 1619 | if ($is_dir) { |
---|
| 1620 | # A copied directory needs to be treated as a new file, exported |
---|
| 1621 | # and added recursively |
---|
| 1622 | $is_newfile = 1; |
---|
| 1623 | $export_required = 1; |
---|
| 1624 | $recursive_add = 1; |
---|
| 1625 | push @copied_dirs, $file; |
---|
| 1626 | } else { |
---|
| 1627 | # History exists for this file |
---|
| 1628 | my $copyfrom_path = $log{$rev}{paths}{$path}{'copyfrom-path'}; |
---|
| 1629 | my $copyfrom_rev = $log{$rev}{paths}{$path}{'copyfrom-rev'}; |
---|
| 1630 | my $cp_url = Fcm::CmUrl->new ( |
---|
| 1631 | URL => $url->root . $copyfrom_path . '@' . $copyfrom_rev, |
---|
| 1632 | ); |
---|
| 1633 | |
---|
| 1634 | if ($copyfrom_path =~ s#^$url_path/*##) { |
---|
| 1635 | # File is copied from a file under the specified URL |
---|
| 1636 | # Check source exists |
---|
| 1637 | $is_newfile = 1 unless $cp_url->url_exists ($rev - 1); |
---|
| 1638 | } else { |
---|
| 1639 | # File copied from outside of the specified URL |
---|
| 1640 | $is_newfile = 1; |
---|
| 1641 | |
---|
| 1642 | # Check branches can be determined |
---|
| 1643 | if ($url->branch and $cp_url->branch) { |
---|
| 1644 | |
---|
| 1645 | # Follow its history, stop on copy |
---|
| 1646 | my %cp_log = $cp_url->svnlog (STOP_ON_COPY => 1); |
---|
| 1647 | |
---|
| 1648 | # "First" revision of the copied file |
---|
| 1649 | my $cp_rev = (sort {$a <=> $b} keys %cp_log) [0]; |
---|
| 1650 | my %attrib = %{ $cp_log{$cp_rev}{paths}{$cp_url->path} } |
---|
| 1651 | if $cp_log{$cp_rev}{paths}{$cp_url->path}; |
---|
| 1652 | |
---|
| 1653 | # Check whether the "first" revision is copied from elsewhere. |
---|
| 1654 | if (exists $attrib{'copyfrom-path'}) { |
---|
| 1655 | # If source exists in the specified URL, set up the copy |
---|
| 1656 | my $cp_cp_url = Fcm::CmUrl->new ( |
---|
| 1657 | URL => $url->root . $attrib{'copyfrom-path'} . '@' . |
---|
| 1658 | $attrib{'copyfrom-rev'}, |
---|
| 1659 | ); |
---|
| 1660 | $cp_cp_url->branch ($url->branch); |
---|
| 1661 | if ($cp_cp_url->url_exists ($rev - 1)) { |
---|
| 1662 | ($copyfrom_path = $cp_cp_url->path) =~ s#^$url_path/*##; |
---|
| 1663 | # Check path is defined - if not it probably means the |
---|
| 1664 | # branch doesn't follow the FCM naming convention |
---|
| 1665 | $is_newfile = 0 if $copyfrom_path; |
---|
| 1666 | } |
---|
| 1667 | } |
---|
| 1668 | |
---|
| 1669 | # Note: The logic above does not cover all cases. However, it |
---|
| 1670 | # should do the right thing for the most common case. Even |
---|
| 1671 | # where it gets it wrong the file contents should always be |
---|
| 1672 | # correct even if the file history is not. |
---|
| 1673 | } |
---|
| 1674 | } |
---|
| 1675 | |
---|
| 1676 | # Check whether file is copied from an excluded path |
---|
| 1677 | if (not $is_newfile) { |
---|
| 1678 | for my $exclude (@exclude) { |
---|
| 1679 | if ($copyfrom_path =~ m#^$exclude(?:/*|$)#) { |
---|
| 1680 | $is_newfile = 1; |
---|
| 1681 | last; |
---|
| 1682 | } |
---|
| 1683 | } |
---|
| 1684 | } |
---|
| 1685 | |
---|
| 1686 | # Script to copy file, if required |
---|
| 1687 | push @before_script, 'svn copy ' . $copyfrom_path . ' ' . $file |
---|
| 1688 | if not $is_newfile; |
---|
| 1689 | } |
---|
| 1690 | |
---|
| 1691 | } else { |
---|
| 1692 | # History does not exist, must be a new file |
---|
| 1693 | $is_newfile = 1; |
---|
| 1694 | # If it's a directory then create it (in case patch doesn't) |
---|
| 1695 | push @before_script, 'mkdir ' . $file if $is_dir; |
---|
| 1696 | } |
---|
| 1697 | } |
---|
| 1698 | |
---|
| 1699 | if ($log{$rev}{paths}{$path}{action} eq 'R') { |
---|
| 1700 | # Script to delete file |
---|
| 1701 | push @before_script, 'svn delete ' . $file; |
---|
| 1702 | |
---|
| 1703 | # Now treat as new file |
---|
| 1704 | $is_newfile = 1; |
---|
| 1705 | } |
---|
| 1706 | |
---|
| 1707 | # Script to add the file, if required |
---|
| 1708 | if ($is_newfile) { |
---|
| 1709 | if ($recursive_add) { |
---|
| 1710 | push @after_script, 'svn add ' . $file; |
---|
| 1711 | } else { |
---|
| 1712 | push @after_script, 'svn add --non-recursive ' . $file; |
---|
| 1713 | } |
---|
| 1714 | } |
---|
| 1715 | |
---|
| 1716 | # Decide whether the file needs to be exported |
---|
| 1717 | if (not $is_dir) { |
---|
| 1718 | if (not $use_patch) { |
---|
| 1719 | $export_required = 1; |
---|
| 1720 | } else { |
---|
| 1721 | # Export the file if it is binary |
---|
| 1722 | my @mime_type = &run_command |
---|
| 1723 | ([qw/svn propget svn:mime-type/, $url_file], METHOD => 'qx'); |
---|
| 1724 | for (@mime_type) { |
---|
| 1725 | $export_required = 1 if not /^text\//; |
---|
| 1726 | } |
---|
| 1727 | # Only create a patch file if necessary |
---|
| 1728 | $patch_needed = 1 if not $export_required; |
---|
| 1729 | } |
---|
| 1730 | } |
---|
| 1731 | |
---|
| 1732 | if ($export_required) { |
---|
| 1733 | # Download the file using "svn export" |
---|
| 1734 | my $export = File::Spec->catfile ($outdir_rev, $export_file); |
---|
| 1735 | &run_command ([qw/svn export -q -r/, $rev, $url_file, $export]); |
---|
| 1736 | |
---|
| 1737 | # Copy the exported file into the file |
---|
| 1738 | push @before_script, |
---|
| 1739 | 'cp -r ${fcm_patch_dir}/' . $export_file . ' ' . $file; |
---|
| 1740 | $export_file++; |
---|
| 1741 | } |
---|
| 1742 | } |
---|
| 1743 | } |
---|
| 1744 | |
---|
| 1745 | # Write the patch file |
---|
| 1746 | if ($patch_needed) { |
---|
| 1747 | my $patchfile = File::Spec->catfile ($outdir_rev, 'patchfile'); |
---|
| 1748 | open FILE, '>', $patchfile |
---|
| 1749 | or die $patchfile, ': cannot open (', $!, ')'; |
---|
| 1750 | print FILE @patch; |
---|
| 1751 | close FILE or die $patchfile, ': cannot close (', $!, ')'; |
---|
| 1752 | } |
---|
| 1753 | |
---|
| 1754 | # Add line break to each line in @before_script and @after_script |
---|
| 1755 | @before_script = map {($_ ? $_ . ' || exit 1' . "\n" : "\n")} |
---|
| 1756 | @before_script if (@before_script); |
---|
| 1757 | @after_script = map {($_ ? $_ . ' || exit 1' . "\n" : "\n")} |
---|
| 1758 | @after_script if (@after_script); |
---|
| 1759 | |
---|
| 1760 | # Write patch script to output |
---|
| 1761 | my $out = File::Spec->catfile ($outdir_rev, 'apply-patch'); |
---|
| 1762 | open FILE, '>', $out or die $out, ': cannot open (', $!, ')'; |
---|
| 1763 | |
---|
| 1764 | # Script header |
---|
| 1765 | my $shell = Fcm::Config->instance()->setting(qw/TOOL SHELL/); |
---|
| 1766 | print FILE <<EOF; |
---|
| 1767 | #!$shell |
---|
| 1768 | # ------------------------------------------------------------------------------ |
---|
| 1769 | # NAME |
---|
| 1770 | # apply-patch |
---|
| 1771 | # |
---|
| 1772 | # DESCRIPTION |
---|
| 1773 | # This script is generated automatically by the "fcm mkpatch" command. It |
---|
| 1774 | # applies the patch to the current working directory which must be a working |
---|
| 1775 | # copy of a valid project tree that can accept the import of the patches. |
---|
| 1776 | # |
---|
| 1777 | # Patch created from $organisation URL: $u |
---|
| 1778 | # Changeset: $rev |
---|
| 1779 | # ------------------------------------------------------------------------------ |
---|
| 1780 | |
---|
| 1781 | this=`basename \$0` |
---|
| 1782 | echo "\$this: Applying patch for changeset $rev." |
---|
| 1783 | |
---|
| 1784 | # Location of the patch, base on the location of this script |
---|
| 1785 | cd `dirname \$0` || exit 1 |
---|
| 1786 | fcm_patch_dir=\$PWD |
---|
| 1787 | |
---|
| 1788 | # Change directory back to the working copy |
---|
| 1789 | cd \$OLDPWD || exit 1 |
---|
| 1790 | |
---|
| 1791 | # Check working copy does not have local changes |
---|
| 1792 | status=`svn status` |
---|
| 1793 | if [[ -n \$status ]]; then |
---|
| 1794 | echo "\$this: working copy contains changes, abort." >&2 |
---|
| 1795 | exit 1 |
---|
| 1796 | fi |
---|
| 1797 | if [[ -a "#commit_message#" ]]; then |
---|
| 1798 | echo "\$this: existing commit message in "#commit_message#", abort." >&2 |
---|
| 1799 | exit 1 |
---|
| 1800 | fi |
---|
| 1801 | |
---|
| 1802 | # Apply the changes |
---|
| 1803 | EOF |
---|
| 1804 | |
---|
| 1805 | # Script content |
---|
| 1806 | print FILE @before_script if @before_script; |
---|
| 1807 | print FILE "patch -p0 <\${fcm_patch_dir}/patchfile || exit 1\n" |
---|
| 1808 | if $patch_needed; |
---|
| 1809 | print FILE @after_script if @after_script; |
---|
| 1810 | |
---|
| 1811 | # Script footer |
---|
| 1812 | print FILE <<EOF; |
---|
| 1813 | |
---|
| 1814 | # Copy in the commit message |
---|
| 1815 | cp \${fcm_patch_dir}/log-message "#commit_message#" |
---|
| 1816 | |
---|
| 1817 | echo "\$this: finished normally." |
---|
| 1818 | #EOF |
---|
| 1819 | EOF |
---|
| 1820 | |
---|
| 1821 | close FILE or die $out, ': cannot close (', $!, ')'; |
---|
| 1822 | |
---|
| 1823 | # Add executable permission |
---|
| 1824 | chmod 0755, $out; |
---|
| 1825 | |
---|
| 1826 | # Script to commit the change |
---|
| 1827 | push @script, '${fcm_patches_dir}/' . $rev . '/apply-patch'; |
---|
| 1828 | push @script, 'svn commit -F "#commit_message#"'; |
---|
| 1829 | push @script, 'rm -f "#commit_message#"'; |
---|
| 1830 | push @script, 'svn update'; |
---|
| 1831 | push @script, ''; |
---|
| 1832 | |
---|
| 1833 | $CLI_MESSAGE->('PATCH_REV', $rev); |
---|
| 1834 | } |
---|
| 1835 | |
---|
| 1836 | # Write the main output script if necessary. Otherwise remove output directory |
---|
| 1837 | # ---------------------------------------------------------------------------- |
---|
| 1838 | if (@script) { |
---|
| 1839 | # Add line break to each line in @script |
---|
| 1840 | @script = map {($_ ? $_ . ' || exit 1' . "\n" : "\n")} @script; |
---|
| 1841 | |
---|
| 1842 | # Write script to output |
---|
| 1843 | my $out = File::Spec->catfile ($outdir, 'fcm-import-patch'); |
---|
| 1844 | open FILE, '>', $out or die $out, ': cannot open (', $!, ')'; |
---|
| 1845 | |
---|
| 1846 | # Script header |
---|
| 1847 | my $shell = Fcm::Config->instance()->setting(qw/TOOL SHELL/); |
---|
| 1848 | print FILE <<EOF; |
---|
| 1849 | #!$shell |
---|
| 1850 | # ------------------------------------------------------------------------------ |
---|
| 1851 | # NAME |
---|
| 1852 | # fcm-import-patch |
---|
| 1853 | # |
---|
| 1854 | # SYNOPSIS |
---|
| 1855 | # fcm-import-patch TARGET |
---|
| 1856 | # |
---|
| 1857 | # DESCRIPTION |
---|
| 1858 | # This script is generated automatically by the "fcm mkpatch" command, as are |
---|
| 1859 | # the revision "patches" created in the same directory. The script imports the |
---|
| 1860 | # patches into TARGET, which must either be a URL or a working copy of a valid |
---|
| 1861 | # project tree that can accept the import of the patches. |
---|
| 1862 | # |
---|
| 1863 | # Patch created from $organisation URL: $u |
---|
| 1864 | # ------------------------------------------------------------------------------ |
---|
| 1865 | |
---|
| 1866 | this=`basename \$0` |
---|
| 1867 | |
---|
| 1868 | # Check argument |
---|
| 1869 | target=\$1 |
---|
| 1870 | |
---|
| 1871 | # First argument must be a URL or working copy |
---|
| 1872 | if [[ -z \$target ]]; then |
---|
| 1873 | echo "\$this: the first argument must be a URL or a working copy, abort." >&2 |
---|
| 1874 | exit 1 |
---|
| 1875 | fi |
---|
| 1876 | |
---|
| 1877 | if [[ \$target == svn://* || \$target == svn+ssh://* || \\ |
---|
| 1878 | \$target == http://* || \$target == https://* || \\ |
---|
| 1879 | \$target == file://* ]]; then |
---|
| 1880 | # A URL, checkout a working copy in a temporary location |
---|
| 1881 | fcm_tmp_dir=`mktemp -d \${TMPDIR:=/tmp}/\$this.XXXXXX` |
---|
| 1882 | fcm_working_copy=\$fcm_tmp_dir |
---|
| 1883 | svn checkout -q \$target \$fcm_working_copy || exit 1 |
---|
| 1884 | else |
---|
| 1885 | fcm_working_copy=\$target |
---|
| 1886 | fi |
---|
| 1887 | |
---|
| 1888 | # Location of the patches, base on the location of this script |
---|
| 1889 | cd `dirname \$0` || exit 1 |
---|
| 1890 | fcm_patches_dir=\$PWD |
---|
| 1891 | |
---|
| 1892 | # Change directory to the working copy |
---|
| 1893 | cd \$fcm_working_copy || exit 1 |
---|
| 1894 | |
---|
| 1895 | # Set the language to avoid encoding problems |
---|
| 1896 | export LANG=en_GB |
---|
| 1897 | |
---|
| 1898 | # Commands to apply patches |
---|
| 1899 | EOF |
---|
| 1900 | |
---|
| 1901 | # Script content |
---|
| 1902 | print FILE @script; |
---|
| 1903 | |
---|
| 1904 | # Script footer |
---|
| 1905 | print FILE <<EOF; |
---|
| 1906 | # Remove temporary working copy, if necessary |
---|
| 1907 | if [[ -d \$fcm_tmp_dir && -w \$fcm_tmp_dir ]]; then |
---|
| 1908 | rm -rf \$fcm_tmp_dir |
---|
| 1909 | fi |
---|
| 1910 | |
---|
| 1911 | echo "\$this: finished normally." |
---|
| 1912 | #EOF |
---|
| 1913 | EOF |
---|
| 1914 | |
---|
| 1915 | close FILE or die $out, ': cannot close (', $!, ')'; |
---|
| 1916 | |
---|
| 1917 | # Add executable permission |
---|
| 1918 | chmod 0755, $out; |
---|
| 1919 | |
---|
| 1920 | # Diagnostic |
---|
| 1921 | $CLI_MESSAGE->('PATCH_DONE', $outdir); |
---|
| 1922 | |
---|
| 1923 | } else { |
---|
| 1924 | # Remove output directory |
---|
| 1925 | rmtree $outdir or die $outdir, ': cannot remove'; |
---|
| 1926 | |
---|
| 1927 | # Diagnostic |
---|
| 1928 | return _cm_abort(Fcm::Cm::Abort->NULL); |
---|
| 1929 | } |
---|
| 1930 | |
---|
| 1931 | return 1; |
---|
| 1932 | } |
---|
| 1933 | |
---|
| 1934 | # ------------------------------------------------------------------------------ |
---|
| 1935 | # CLI: fcm add. |
---|
| 1936 | sub _cli_command_add { |
---|
| 1937 | my @args = map {($_ eq '--check' || $_ eq '-c' ? () : $_)} @_; |
---|
| 1938 | my %option = (st_check_handler => $CLI_HANDLER_OF{'WC_STATUS_PATH'}); |
---|
| 1939 | return ( |
---|
| 1940 | @args == @_ ? _svn("add", @args) : cm_check_unknown(\%option, @args) |
---|
| 1941 | ); |
---|
| 1942 | } |
---|
| 1943 | |
---|
| 1944 | # ------------------------------------------------------------------------------ |
---|
| 1945 | # CLI: fcm checkout. |
---|
| 1946 | sub _cli_command_checkout { |
---|
| 1947 | if (@ARGV) { |
---|
| 1948 | my $target = is_url($ARGV[-1]) ? cwd() : $ARGV[-1]; |
---|
| 1949 | if (-d $target && is_wc($target)) { |
---|
| 1950 | return _cm_err(Fcm::Cm::Exception->WC_EXIST, $target); |
---|
| 1951 | } |
---|
| 1952 | } |
---|
| 1953 | return _svn('checkout', @ARGV); |
---|
| 1954 | } |
---|
| 1955 | |
---|
| 1956 | # ------------------------------------------------------------------------------ |
---|
| 1957 | # CLI: fcm delete. |
---|
| 1958 | sub _cli_command_delete { |
---|
| 1959 | my @args = map {($_ eq '--check' || $_ eq '-c' ? () : $_)} @_; |
---|
| 1960 | my %option = (st_check_handler => $CLI_HANDLER_OF{'WC_STATUS_PATH'}); |
---|
| 1961 | return ( |
---|
| 1962 | @args == @_ ? _svn("delete", @args) : cm_check_missing(\%option, @args) |
---|
| 1963 | ); |
---|
| 1964 | } |
---|
| 1965 | |
---|
| 1966 | # ------------------------------------------------------------------------------ |
---|
| 1967 | # CLI: fcm switch. |
---|
| 1968 | sub _cli_command_switch { |
---|
| 1969 | local(@ARGV) = @_; |
---|
| 1970 | if (grep {$_ eq '--relocate'} @ARGV) { |
---|
| 1971 | return _svn('switch', @ARGV); |
---|
| 1972 | } |
---|
| 1973 | my %option; |
---|
| 1974 | if (!GetOptions(\%option, 'non-interactive', 'revision|r=s', 'quiet|q')) { |
---|
| 1975 | _cli_err(); |
---|
| 1976 | } |
---|
| 1977 | if (!$option{'non-interactive'}) { |
---|
| 1978 | $option{st_check_handler} = $CLI_HANDLER_OF{WC_STATUS}; |
---|
| 1979 | } |
---|
| 1980 | if (!@ARGV) { |
---|
| 1981 | _cli_err(); |
---|
| 1982 | } |
---|
| 1983 | $CLI_MESSAGE->(q{}, join(q{}, cm_switch(\%option, @ARGV))); |
---|
| 1984 | } |
---|
| 1985 | |
---|
| 1986 | # ------------------------------------------------------------------------------ |
---|
| 1987 | # CLI: fcm update. |
---|
| 1988 | sub _cli_command_update { |
---|
| 1989 | local(@ARGV) = @_; |
---|
| 1990 | my %option; |
---|
| 1991 | if (!GetOptions(\%option, 'non-interactive', 'revision|r=s', 'quiet|q')) { |
---|
| 1992 | _cli_err(); |
---|
| 1993 | } |
---|
| 1994 | if (!$option{'non-interactive'}) { |
---|
| 1995 | $option{st_check_handler} = $CLI_HANDLER_OF{WC_STATUS}; |
---|
| 1996 | } |
---|
| 1997 | $CLI_MESSAGE->(q{}, join(q{}, cm_update(\%option, @ARGV))); |
---|
| 1998 | } |
---|
| 1999 | |
---|
| 2000 | # ------------------------------------------------------------------------------ |
---|
| 2001 | # CLI error. |
---|
| 2002 | sub _cli_err { |
---|
| 2003 | my ($key, @args) = @_; |
---|
| 2004 | $key ||= 'CLI_USAGE'; |
---|
| 2005 | my $message = sprintf($CLI_MESSAGE_FOR_ERROR{$key}, @args); |
---|
| 2006 | die(Fcm::CLI::Exception->new({message => $message})); |
---|
| 2007 | } |
---|
| 2008 | |
---|
| 2009 | # ------------------------------------------------------------------------------ |
---|
| 2010 | # Handles abort exception. |
---|
| 2011 | sub _cli_e_handler_of_cm_abort { |
---|
| 2012 | my ($function, $e) = @_; |
---|
| 2013 | if ($e->get_code() eq $e->FAIL) { |
---|
| 2014 | die(sprintf($CLI_MESSAGE_FOR_ABORT{FAIL}, $function)); |
---|
| 2015 | } |
---|
| 2016 | else { |
---|
| 2017 | $CLI_MESSAGE->($e->get_code(), $function); |
---|
| 2018 | } |
---|
| 2019 | } |
---|
| 2020 | |
---|
| 2021 | # ------------------------------------------------------------------------------ |
---|
| 2022 | # Handles CM exception. |
---|
| 2023 | sub _cli_e_handler_of_cm_exception { |
---|
| 2024 | my ($function, $e) = @_; |
---|
| 2025 | die(sprintf($CLI_MESSAGE_FOR_ERROR{$e->get_code()}, $e->get_targets())); |
---|
| 2026 | } |
---|
| 2027 | |
---|
| 2028 | # ------------------------------------------------------------------------------ |
---|
| 2029 | # Handles CLI exception. |
---|
| 2030 | sub _cli_e_handler_of_cli_exception { |
---|
| 2031 | my ($function, $e) = @_; |
---|
| 2032 | $CLI_MESSAGE->('CLI', $e); |
---|
| 2033 | $CLI_MESSAGE->('CLI_HELP', $function); |
---|
| 2034 | } |
---|
| 2035 | |
---|
| 2036 | # ------------------------------------------------------------------------------ |
---|
| 2037 | # The default handler of the "WC_STATUS" event. |
---|
| 2038 | sub _cli_handler_of_wc_status { |
---|
| 2039 | my ($name, $target_list_ref, $status_list_ref) = @_; |
---|
| 2040 | if (@{$status_list_ref}) { |
---|
| 2041 | $CLI_MESSAGE->('STATUS', join(q{}, @{$status_list_ref})); |
---|
| 2042 | if ($CLI_PROMPT->($name, 'CONTINUE') ne 'y') { |
---|
| 2043 | return _cm_abort(); |
---|
| 2044 | } |
---|
| 2045 | } |
---|
| 2046 | return @{$status_list_ref}; |
---|
| 2047 | } |
---|
| 2048 | |
---|
| 2049 | # ------------------------------------------------------------------------------ |
---|
| 2050 | # The default handler of the "WC_STATUS_PATH" event. |
---|
| 2051 | sub _cli_handler_of_wc_status_path { |
---|
| 2052 | my ($name, $target_list_ref, $status_list_ref) = @_; |
---|
| 2053 | $CLI_MESSAGE->(q{}, join(q{}, @{$status_list_ref})); |
---|
| 2054 | my @paths = map {chomp(); ($_ =~ $PATTERN_OF{ST_PATH})} @{$status_list_ref}; |
---|
| 2055 | my @paths_of_interest; |
---|
| 2056 | while (my $path = shift(@paths)) { |
---|
| 2057 | my %handler_of = ( |
---|
| 2058 | a => sub {push(@paths_of_interest, $path, @paths); @paths = ()}, |
---|
| 2059 | n => sub {}, |
---|
| 2060 | y => sub {push(@paths_of_interest, $path)}, |
---|
| 2061 | ); |
---|
| 2062 | my $reply = $CLI_PROMPT->( |
---|
| 2063 | {type => 'yna'}, $name, 'RUN_SVN_COMMAND', "$name $path", |
---|
| 2064 | ); |
---|
| 2065 | $handler_of{$reply}->(); |
---|
| 2066 | } |
---|
| 2067 | return @paths_of_interest; |
---|
| 2068 | } |
---|
| 2069 | |
---|
| 2070 | # ------------------------------------------------------------------------------ |
---|
| 2071 | # Prints help for a given $subcommand. |
---|
| 2072 | sub _cli_help { |
---|
| 2073 | my ($key, $exit_val) = @_; |
---|
| 2074 | my $pod |
---|
| 2075 | = File::Spec->catfile(dirname($INC{'Fcm/Cm.pm'}), 'CLI', "fcm-$key.pod"); |
---|
| 2076 | my $has_pod = -f $pod; |
---|
| 2077 | if ($has_pod) { |
---|
| 2078 | pod2usage({ |
---|
| 2079 | '-exitval' => defined($exit_val) ? $exit_val : 2, |
---|
| 2080 | '-input' => $pod, |
---|
| 2081 | '-verbose' => 1, |
---|
| 2082 | }); |
---|
| 2083 | } |
---|
| 2084 | if (!$has_pod || exists($CLI_MORE_HELP_FOR{$key})) { |
---|
| 2085 | local(@ARGV) = ($key); |
---|
| 2086 | return _svn('help', $key); |
---|
| 2087 | } |
---|
| 2088 | } |
---|
| 2089 | |
---|
| 2090 | # ------------------------------------------------------------------------------ |
---|
| 2091 | # Expands location keywords in a list. |
---|
| 2092 | sub _cli_keyword_expand_url { |
---|
| 2093 | my ($arg_list_ref) = @_; |
---|
| 2094 | ARG: |
---|
| 2095 | for my $arg (@{$arg_list_ref}) { |
---|
| 2096 | my ($label, $value) = ($arg =~ $PATTERN_OF{CLI_OPT}); |
---|
| 2097 | if (!$label) { |
---|
| 2098 | ($label, $value) = (q{}, $arg); |
---|
| 2099 | } |
---|
| 2100 | if (!$value) { |
---|
| 2101 | next ARG; |
---|
| 2102 | } |
---|
| 2103 | eval { |
---|
| 2104 | $value = Fcm::Util::tidy_url(Fcm::Keyword::expand($value)); |
---|
| 2105 | }; |
---|
| 2106 | if ($@) { |
---|
| 2107 | if ($value ne 'fcm:revision') { |
---|
| 2108 | die($@); |
---|
| 2109 | } |
---|
| 2110 | } |
---|
| 2111 | $arg = $label . $value; |
---|
| 2112 | } |
---|
| 2113 | } |
---|
| 2114 | |
---|
| 2115 | # ------------------------------------------------------------------------------ |
---|
| 2116 | # Expands revision keywords in -r and --revision options in a list. |
---|
| 2117 | sub _cli_keyword_expand_rev { |
---|
| 2118 | my ($arg_list_ref) = @_; |
---|
| 2119 | my @targets; |
---|
| 2120 | for my $arg (@{$arg_list_ref}) { |
---|
| 2121 | if (-e $arg && is_wc($arg) || is_url($arg)) { |
---|
| 2122 | push(@targets, $arg); |
---|
| 2123 | } |
---|
| 2124 | } |
---|
| 2125 | if (!@targets) { |
---|
| 2126 | push(@targets, get_url_of_wc()); |
---|
| 2127 | } |
---|
| 2128 | if (!@targets) { |
---|
| 2129 | return; |
---|
| 2130 | } |
---|
| 2131 | my @old_arg_list = @{$arg_list_ref}; |
---|
| 2132 | my @new_arg_list = (); |
---|
| 2133 | ARG: |
---|
| 2134 | while (defined(my $arg = shift(@old_arg_list))) { |
---|
| 2135 | my ($key, $value) = $arg =~ $PATTERN_OF{CLI_OPT_REV}; |
---|
| 2136 | if (!$key) { |
---|
| 2137 | push(@new_arg_list, $arg); |
---|
| 2138 | next ARG; |
---|
| 2139 | } |
---|
| 2140 | push(@new_arg_list, '--revision'); |
---|
| 2141 | if (!$value) { |
---|
| 2142 | $value = shift(@old_arg_list); |
---|
| 2143 | } |
---|
| 2144 | my @revs = grep {defined()} ($value =~ $PATTERN_OF{CLI_OPT_REV_RANGE}); |
---|
| 2145 | my ($url, @url_list) = @targets; |
---|
| 2146 | for my $rev (@revs) { |
---|
| 2147 | if ($rev !~ $PATTERN_OF{SVN_REV}) { |
---|
| 2148 | $rev = (Fcm::Keyword::expand($url, $rev))[1]; |
---|
| 2149 | } |
---|
| 2150 | if (@url_list) { |
---|
| 2151 | $url = shift(@url_list); |
---|
| 2152 | } |
---|
| 2153 | } |
---|
| 2154 | push(@new_arg_list, join(q{:}, @revs)); |
---|
| 2155 | } |
---|
| 2156 | @{$arg_list_ref} = @new_arg_list; |
---|
| 2157 | } |
---|
| 2158 | |
---|
| 2159 | # ------------------------------------------------------------------------------ |
---|
| 2160 | # Prints a message. |
---|
| 2161 | sub _cli_message { |
---|
| 2162 | my ($key, @args) = @_; |
---|
| 2163 | for ( |
---|
| 2164 | [\*STDOUT, \%CLI_MESSAGE_FOR , q{} ], |
---|
| 2165 | [\*STDERR, \%CLI_MESSAGE_FOR_WARNING, q{[WARNING] }], |
---|
| 2166 | [\*STDERR, \%CLI_MESSAGE_FOR_ABORT , q{[ABORT] } ], |
---|
| 2167 | [\*STDERR, \%CLI_MESSAGE_FOR_ERROR , q{[ERROR] } ], |
---|
| 2168 | ) { |
---|
| 2169 | my ($handle, $hash_ref, $prefix) = @{$_}; |
---|
| 2170 | if (exists($hash_ref->{$key})) { |
---|
| 2171 | return printf({$handle} $prefix . $hash_ref->{$key}, @args); |
---|
| 2172 | } |
---|
| 2173 | } |
---|
| 2174 | } |
---|
| 2175 | |
---|
| 2176 | # ------------------------------------------------------------------------------ |
---|
| 2177 | # Wrapper for Fcm::Interactive::get_input. |
---|
| 2178 | sub _cli_prompt { |
---|
| 2179 | my %option |
---|
| 2180 | = (type => 'yn', default => 'n', (ref($_[0]) ? %{shift(@_)} : ())); |
---|
| 2181 | my ($name, $key, @args) = @_; |
---|
| 2182 | return Fcm::Interactive::get_input( |
---|
| 2183 | title => $CLI_PROMPT_PREFIX . $name, |
---|
| 2184 | message => sprintf($CLI_MESSAGE_FOR_PROMPT{$key}, @args), |
---|
| 2185 | %option, |
---|
| 2186 | ); |
---|
| 2187 | } |
---|
| 2188 | |
---|
| 2189 | # ------------------------------------------------------------------------------ |
---|
| 2190 | # Check missing status and delete. |
---|
| 2191 | sub cm_check_missing { |
---|
| 2192 | my %option = %{shift()}; |
---|
| 2193 | my $checker |
---|
| 2194 | = _svn_status_checker('delete', 'MISSING', $option{st_check_handler}); |
---|
| 2195 | my @paths = $checker->(\@_); |
---|
| 2196 | if (@paths) { |
---|
| 2197 | run_command([qw{svn delete}, @paths]); |
---|
| 2198 | } |
---|
| 2199 | } |
---|
| 2200 | |
---|
| 2201 | # ------------------------------------------------------------------------------ |
---|
| 2202 | # Check unknown status and add. |
---|
| 2203 | sub cm_check_unknown { |
---|
| 2204 | my %option = %{shift()}; |
---|
| 2205 | my $checker |
---|
| 2206 | = _svn_status_checker('add', 'UNKNOWN', $option{st_check_handler}); |
---|
| 2207 | my @paths = $checker->(\@_); |
---|
| 2208 | if (@paths) { |
---|
| 2209 | run_command([qw{svn add}, @paths]); |
---|
| 2210 | } |
---|
| 2211 | } |
---|
| 2212 | |
---|
| 2213 | # ------------------------------------------------------------------------------ |
---|
| 2214 | # FCM wrapper to SVN switch. |
---|
| 2215 | sub cm_switch { |
---|
| 2216 | my %option = %{shift()}; |
---|
| 2217 | my ($target, $path) = @_; |
---|
| 2218 | $path ||= cwd(); |
---|
| 2219 | if (!-e $path) { |
---|
| 2220 | return _cm_err(Fcm::Cm::Exception->NOT_EXIST, $path); |
---|
| 2221 | } |
---|
| 2222 | if (!is_wc($path)) { |
---|
| 2223 | return _cm_err(Fcm::Cm::Exception->INVALID_WC, $path); |
---|
| 2224 | } |
---|
| 2225 | |
---|
| 2226 | # Check for merge template in the commit log file in the working copy |
---|
| 2227 | my $path_of_wc = get_wct($path); |
---|
| 2228 | my $ci_mesg = Fcm::CmCommitMessage->new(); |
---|
| 2229 | $ci_mesg->dir($path_of_wc); |
---|
| 2230 | $ci_mesg->read_file(); |
---|
| 2231 | if (@{$ci_mesg->auto_mesg()}) { |
---|
| 2232 | return _cm_err( |
---|
| 2233 | Fcm::Cm::Exception->SWITCH_UNSAFE, |
---|
| 2234 | $path eq $path_of_wc ? $ci_mesg->base() : $ci_mesg->file(), |
---|
| 2235 | ); |
---|
| 2236 | } |
---|
| 2237 | |
---|
| 2238 | # Check for any local modifications |
---|
| 2239 | if (defined($option{st_check_handler})) { |
---|
| 2240 | my $handler = $CLI_HANDLER_OF{WC_STATUS}; |
---|
| 2241 | _svn_status_checker('switch', 'MODIFIED', $handler)->([$path_of_wc]); |
---|
| 2242 | } |
---|
| 2243 | |
---|
| 2244 | # Invokes "svn switch" |
---|
| 2245 | _svn( |
---|
| 2246 | {METHOD => 'qx', PRINT => !$option{quiet}}, |
---|
| 2247 | 'switch', |
---|
| 2248 | ($option{'non-interactive'} ? '--non-interactive' : ()), |
---|
| 2249 | ($option{revision} ? ('-r', $option{revision}) : ()), |
---|
| 2250 | ($option{quiet} ? '--quiet' : ()), |
---|
| 2251 | _cm_get_source( |
---|
| 2252 | $target, |
---|
| 2253 | Fcm::CmBranch->new(URL => get_url_of_wc($path_of_wc)), |
---|
| 2254 | )->url_peg(), |
---|
| 2255 | ($path_of_wc eq cwd() ? () : $path_of_wc), |
---|
| 2256 | ); |
---|
| 2257 | } |
---|
| 2258 | |
---|
| 2259 | # ------------------------------------------------------------------------------ |
---|
| 2260 | # FCM wrapper to SVN update. |
---|
| 2261 | sub cm_update { |
---|
| 2262 | my %option = %{shift()}; |
---|
| 2263 | my @targets = @_; |
---|
| 2264 | if (!@targets) { |
---|
| 2265 | @targets = (cwd()); |
---|
| 2266 | } |
---|
| 2267 | for my $target (@targets) { |
---|
| 2268 | if (!-e $target) { |
---|
| 2269 | return _cm_err(Fcm::Cm::Exception->NOT_EXIST, $target); |
---|
| 2270 | } |
---|
| 2271 | if (!is_wc($target)) { |
---|
| 2272 | return _cm_err(Fcm::Cm::Exception->INVALID_WC, $target); |
---|
| 2273 | } |
---|
| 2274 | $target = get_wct($target); |
---|
| 2275 | if ($target eq cwd()) { |
---|
| 2276 | $target = q{.}; |
---|
| 2277 | } |
---|
| 2278 | } |
---|
| 2279 | if (defined($option{st_check_handler})) { |
---|
| 2280 | my ($matcher_keys_ref, $show_updates) |
---|
| 2281 | = defined($option{revision}) ? (['MODIFIED' ], undef) |
---|
| 2282 | : (['MODIFIED', 'OUT_OF_DATE'], 1 ) |
---|
| 2283 | ; |
---|
| 2284 | my $matcher = sub { |
---|
| 2285 | for my $key (@{$matcher_keys_ref}) { |
---|
| 2286 | $ST_MATCHER_FOR{$key}->(@_) && return 1; |
---|
| 2287 | } |
---|
| 2288 | }; |
---|
| 2289 | _svn_status_checker( |
---|
| 2290 | 'update', $matcher, $option{st_check_handler}, $show_updates, |
---|
| 2291 | )->(\@targets); |
---|
| 2292 | } |
---|
| 2293 | if ($option{revision} && $option{revision} !~ $PATTERN_OF{SVN_REV}) { |
---|
| 2294 | $option{revision} = ( |
---|
| 2295 | Fcm::Keyword::expand(get_url_of_wc($targets[0]), $option{revision}) |
---|
| 2296 | )[1]; |
---|
| 2297 | } |
---|
| 2298 | return _svn_update(\@targets, \%option); |
---|
| 2299 | } |
---|
| 2300 | |
---|
| 2301 | # ------------------------------------------------------------------------------ |
---|
| 2302 | # Raises an abort exception. |
---|
| 2303 | sub _cm_abort { |
---|
| 2304 | my ($code) = @_; |
---|
| 2305 | $code ||= Fcm::Cm::Abort->USER; |
---|
| 2306 | die(bless({code => $code, message => 'abort'}, 'Fcm::Cm::Abort')); |
---|
| 2307 | } |
---|
| 2308 | |
---|
| 2309 | # ------------------------------------------------------------------------------ |
---|
| 2310 | # Raises a failure. |
---|
| 2311 | sub _cm_err { |
---|
| 2312 | my ($code, @targets) = @_; |
---|
| 2313 | die(bless( |
---|
| 2314 | {code => $code, message => "ERROR: $code", targets => \@targets}, |
---|
| 2315 | 'Fcm::Cm::Exception', |
---|
| 2316 | )); |
---|
| 2317 | } |
---|
| 2318 | |
---|
| 2319 | # ------------------------------------------------------------------------------ |
---|
| 2320 | # Returns the corresponding Fcm::CmBranch instance for $src_url w.r.t. $target. |
---|
| 2321 | sub _cm_get_source { |
---|
| 2322 | my ($src_url, $target) = @_; |
---|
| 2323 | my $source = Fcm::CmBranch->new(URL => $src_url); |
---|
| 2324 | if (!$source->is_url()) { |
---|
| 2325 | # Not a full URL, construct full URL based on current URL |
---|
| 2326 | $source->url_peg($target->url_peg()); |
---|
| 2327 | my $project = $target->project(); |
---|
| 2328 | my ($path) = $src_url =~ qr{\A/*(.*)\z}xms; |
---|
| 2329 | if (index($path, $project) == 0) { |
---|
| 2330 | # Argument contains the full path under the repository root |
---|
| 2331 | $path = substr($path, length($project)); |
---|
| 2332 | } |
---|
| 2333 | if ($path =~ $PATTERN_OF{FCM_BRANCH_PATH}) { |
---|
| 2334 | # Argument contains the full branch name |
---|
| 2335 | $path = join(q{/}, $target->project_path(), $path); |
---|
| 2336 | } |
---|
| 2337 | else { |
---|
| 2338 | # Argument contains the shorter branch name |
---|
| 2339 | $path = join(q{/}, $target->project_path(), 'branches', $path); |
---|
| 2340 | } |
---|
| 2341 | $source->path_peg($path); |
---|
| 2342 | } |
---|
| 2343 | # Replace source sub-directory with the target sub-directory |
---|
| 2344 | $source->subdir($target->subdir()); |
---|
| 2345 | # Ensure that the branch name exists |
---|
| 2346 | if (!$source->url_exists()) { |
---|
| 2347 | return _cm_err(Fcm::Cm::Exception->INVALID_URL, $src_url); |
---|
| 2348 | } |
---|
| 2349 | # Ensure that the branch name is valid |
---|
| 2350 | if (!$source->branch()) { |
---|
| 2351 | return _cm_err(Fcm::Cm::Exception->INVALID_BRANCH, $src_url); |
---|
| 2352 | } |
---|
| 2353 | # Ensure that the source and target URLs are in the same project |
---|
| 2354 | if ($source->project_url() ne $target->project_url()) { |
---|
| 2355 | return _cm_err( |
---|
| 2356 | Fcm::Cm::Exception->DIFF_PROJECTS, |
---|
| 2357 | $target->url_peg(), |
---|
| 2358 | $source->url_peg(), |
---|
| 2359 | ); |
---|
| 2360 | } |
---|
| 2361 | return $source; |
---|
| 2362 | } |
---|
| 2363 | |
---|
| 2364 | # ------------------------------------------------------------------------------ |
---|
| 2365 | # Runs "svn". |
---|
| 2366 | sub _svn { |
---|
| 2367 | my @args = @_; |
---|
| 2368 | my %option; |
---|
| 2369 | if (@args && ref($args[0])) { |
---|
| 2370 | %option = %{shift(@args)}; |
---|
| 2371 | } |
---|
| 2372 | return run_command( |
---|
| 2373 | ['svn', @args], |
---|
| 2374 | PRINT => ($args[0] ne 'cat' && !grep {$_ eq '--xml'} @args), |
---|
| 2375 | %option, |
---|
| 2376 | ); |
---|
| 2377 | } |
---|
| 2378 | |
---|
| 2379 | # ------------------------------------------------------------------------------ |
---|
| 2380 | # Returns the results of "svn status". |
---|
| 2381 | sub _svn_status_get { |
---|
| 2382 | my ($target_list_ref, $show_updates) = @_; |
---|
| 2383 | my @targets = (defined($target_list_ref) ? @{$target_list_ref} : ()); |
---|
| 2384 | for my $target (@targets) { |
---|
| 2385 | if ($target eq cwd()) { |
---|
| 2386 | $target = q{.}; |
---|
| 2387 | } |
---|
| 2388 | } |
---|
| 2389 | my @options = ($show_updates ? qw{--show-updates} : ()); |
---|
| 2390 | return _svn({METHOD => 'qx', PRINT => 0}, 'status', @options, @targets); |
---|
| 2391 | } |
---|
| 2392 | |
---|
| 2393 | # ------------------------------------------------------------------------------ |
---|
| 2394 | # Returns a "svn status" checker. |
---|
| 2395 | sub _svn_status_checker { |
---|
| 2396 | my ($name, $matcher, $handler, $show_updates) = @_; |
---|
| 2397 | if (!ref($matcher)) { |
---|
| 2398 | $matcher = $ST_MATCHER_FOR{$matcher}; |
---|
| 2399 | } |
---|
| 2400 | return sub { |
---|
| 2401 | my ($target_list_ref) = @_; |
---|
| 2402 | my @status = _svn_status_get($target_list_ref, $show_updates); |
---|
| 2403 | if ($show_updates) { |
---|
| 2404 | @status = map {$_ =~ $PATTERN_OF{ST_AGAINST_REV} ? () : $_} @status; |
---|
| 2405 | } |
---|
| 2406 | my @status_of_interest = grep {$matcher->($_)} @status; |
---|
| 2407 | if (defined($handler)) { |
---|
| 2408 | return $handler->($name, $target_list_ref, \@status_of_interest); |
---|
| 2409 | } |
---|
| 2410 | return @status_of_interest; |
---|
| 2411 | } |
---|
| 2412 | } |
---|
| 2413 | |
---|
| 2414 | # ------------------------------------------------------------------------------ |
---|
| 2415 | # Runs "svn update". |
---|
| 2416 | sub _svn_update { |
---|
| 2417 | my ($target_list_ref, $option_hash_ref) = @_; |
---|
| 2418 | my %option = (defined($option_hash_ref) ? %{$option_hash_ref} : ()); |
---|
| 2419 | _svn( |
---|
| 2420 | {METHOD => 'qx', PRINT => !$option{quiet}}, |
---|
| 2421 | 'update', |
---|
| 2422 | ($option{'non-interactive'} ? '--non-interactive' : ()), |
---|
| 2423 | ($option{revision} ? ('-r', $option{revision}) : ()), |
---|
| 2424 | ($option{quiet} ? '--quiet' : ()), |
---|
| 2425 | (defined($target_list_ref) ? @{$target_list_ref} : ()), |
---|
| 2426 | ); |
---|
| 2427 | } |
---|
| 2428 | |
---|
| 2429 | # ------------------------------------------------------------------------------ |
---|
| 2430 | # Abort exception. |
---|
| 2431 | package Fcm::Cm::Abort; |
---|
| 2432 | use base qw{Fcm::Exception}; |
---|
| 2433 | use constant {FAIL => 'FAIL', NULL => 'NULL', USER => 'USER'}; |
---|
| 2434 | |
---|
| 2435 | sub get_code { |
---|
| 2436 | return $_[0]->{code}; |
---|
| 2437 | } |
---|
| 2438 | |
---|
| 2439 | # ------------------------------------------------------------------------------ |
---|
| 2440 | # Resource exception. |
---|
| 2441 | package Fcm::Cm::Exception; |
---|
| 2442 | our @ISA = qw{Fcm::Cm::Abort}; |
---|
| 2443 | use constant { |
---|
| 2444 | CHDIR => 'CHDIR', |
---|
| 2445 | INVALID_BRANCH => 'INVALID_BRANCH', |
---|
| 2446 | INVALID_PROJECT => 'INVALID_PROJECT', |
---|
| 2447 | INVALID_TARGET => 'INVALID_TARGET', |
---|
| 2448 | INVALID_URL => 'INVALID_URL', |
---|
| 2449 | INVALID_WC => 'INVALID_WC', |
---|
| 2450 | MERGE_REV_INVALID => 'MERGE_REV_INVALID', |
---|
| 2451 | MERGE_SELF => 'MERGE_SELF', |
---|
| 2452 | MERGE_UNRELATED => 'MERGE_UNRELATED', |
---|
| 2453 | MERGE_UNSAFE => 'MERGE_UNSAFE', |
---|
| 2454 | MKPATH => 'MKPATH', |
---|
| 2455 | NOT_EXIST => 'NOT_EXIST', |
---|
| 2456 | PARENT_NOT_EXIST => 'PARENT_NOT_EXIST', |
---|
| 2457 | RMTREE => 'RMTREE', |
---|
| 2458 | SWITCH_UNSAFE => 'SWITCH_UNSAFE', |
---|
| 2459 | WC_EXIST => 'WC_EXIST', |
---|
| 2460 | WC_INVALID_BRANCH => 'WC_INVALID_BRANCH', |
---|
| 2461 | WC_URL_NOT_EXIST => 'WC_URL_NOT_EXIST', |
---|
| 2462 | }; |
---|
| 2463 | |
---|
| 2464 | sub get_targets { |
---|
| 2465 | return @{$_[0]->{targets}}; |
---|
| 2466 | } |
---|
| 2467 | |
---|
| 2468 | 1; |
---|
| 2469 | __END__ |
---|
| 2470 | |
---|
| 2471 | =pod |
---|
| 2472 | |
---|
| 2473 | =head1 NAME |
---|
| 2474 | |
---|
| 2475 | Fcm::Cm |
---|
| 2476 | |
---|
| 2477 | =head1 SYNOPSIS |
---|
| 2478 | |
---|
| 2479 | use Fcm::Cm qw{cli}; |
---|
| 2480 | |
---|
| 2481 | # Use as a wrapper to Subversion, and other FCM code management commands |
---|
| 2482 | cli('info', '--revision', 'HEAD', $url); |
---|
| 2483 | |
---|
| 2484 | use Fcm::Cm qw{cm_check_missing cm_check_unknown cm_switch cm_update}; |
---|
| 2485 | |
---|
| 2486 | # Checks status for "missing" items and "svn delete" them |
---|
| 2487 | $missing_st_handler = sub { |
---|
| 2488 | my ($name, $target_list_ref, $status_list_ref) = @_; |
---|
| 2489 | # ... |
---|
| 2490 | return @paths_of_interest; |
---|
| 2491 | }; |
---|
| 2492 | cm_check_missing({st_check_handler => $missing_st_handler}, @targets); |
---|
| 2493 | |
---|
| 2494 | # Checks status for "unknown" items and "svn add" them |
---|
| 2495 | $unknown_st_handler = sub { |
---|
| 2496 | my ($name, $target_list_ref, $status_list_ref) = @_; |
---|
| 2497 | # ... |
---|
| 2498 | return @paths_of_interest; |
---|
| 2499 | }; |
---|
| 2500 | cm_check_unknown({st_check_handler => $unknown_st_handler}, @targets); |
---|
| 2501 | |
---|
| 2502 | # Sets up a status checker |
---|
| 2503 | $st_check_handler = sub { |
---|
| 2504 | my ($name, $target_list_ref, $status_list_ref) = @_; |
---|
| 2505 | # ... |
---|
| 2506 | }; |
---|
| 2507 | # Switches a "working copy" at the "root" level to a new URL target |
---|
| 2508 | cm_switch( |
---|
| 2509 | { |
---|
| 2510 | 'non-interactive' => $non_interactive_flag, |
---|
| 2511 | 'quiet' => $quiet_flag, |
---|
| 2512 | 'revision' => $revision, |
---|
| 2513 | 'st_check_handler' => $st_check_handler, |
---|
| 2514 | }, |
---|
| 2515 | $target, $path_of_wc, |
---|
| 2516 | ); |
---|
| 2517 | # Runs "svn update" on each working copy from their "root" level |
---|
| 2518 | cm_update( |
---|
| 2519 | { |
---|
| 2520 | 'non-interactive' => $non_interactive_flag, |
---|
| 2521 | 'quiet' => $quiet_flag, |
---|
| 2522 | 'revision' => $revision, |
---|
| 2523 | 'st_check_handler' => $st_check_handler, |
---|
| 2524 | }, |
---|
| 2525 | @targets, |
---|
| 2526 | ); |
---|
| 2527 | |
---|
| 2528 | =head1 DESCRIPTION |
---|
| 2529 | |
---|
| 2530 | Wraps the Subversion client and implements other FCM code management |
---|
| 2531 | functionalities. |
---|
| 2532 | |
---|
| 2533 | =head1 FUNCTIONS |
---|
| 2534 | |
---|
| 2535 | =over 4 |
---|
| 2536 | |
---|
| 2537 | =item cli($function,@args) |
---|
| 2538 | |
---|
| 2539 | Implements the FCM code management CLI. If --help or -h is specified in @args, |
---|
| 2540 | it displays help and returns. Otherwise, it attempts to expand any FCM location |
---|
| 2541 | and revision keywords in @args. Calls the relevant FCM code management function |
---|
| 2542 | according to $function, or a SVN command if $function is not modified by FCM. |
---|
| 2543 | |
---|
| 2544 | =item cm_check_missing(\%option,@targets) |
---|
| 2545 | |
---|
| 2546 | Use "svn status" to check for missing items in @targets. If @targets is an empty |
---|
| 2547 | list, the function adds the current working directory to it. Expects |
---|
| 2548 | $option{st_check_handler} to be a CODE reference. Calls |
---|
| 2549 | $option{st_check_handler} with ($name, $target_list_ref, $status_list_ref) where |
---|
| 2550 | $name is "delete", $target_list_ref is \@targets, and $status_list_ref is an |
---|
| 2551 | ARRAY reference to a list of "svn status" output with the "missing" status. |
---|
| 2552 | $option{st_check_handler} should return a list of interesting paths, which will |
---|
| 2553 | be scheduled for removal using "svn delete". |
---|
| 2554 | |
---|
| 2555 | =item cm_check_unknown(\%option,@targets) |
---|
| 2556 | |
---|
| 2557 | Similar to cm_check_missing(\%option,@targets) but checks for "unknown" items, |
---|
| 2558 | which will be scheduled for addition using "svn add". |
---|
| 2559 | |
---|
| 2560 | =item cm_switch(\%option,$target,$path_of_wc) |
---|
| 2561 | |
---|
| 2562 | Invokes "svn switch" at the root of a working copy specified by $path_of_wc (or |
---|
| 2563 | the current working directory if $path_of_wc is not specified). |
---|
| 2564 | $option{'non-interactive'}, $option{quiet}, $option{revision} determines the |
---|
| 2565 | options (of the same name) that are passed to "svn switch". If |
---|
| 2566 | $option{st_check_handler} is set, it should be a CODE reference, and will be |
---|
| 2567 | called with ('switch', [$path_of_wc], $status_list_ref), where $status_list_ref |
---|
| 2568 | is an ARRAY reference to the output returned by "svn status" on $path_of_wc. |
---|
| 2569 | This can be used for the application to display the working copy status to the |
---|
| 2570 | user before prompting him/her to continue. The return value of |
---|
| 2571 | $option{st_check_handler} is ignored. |
---|
| 2572 | |
---|
| 2573 | =item cm_update(\%option,@targets) |
---|
| 2574 | |
---|
| 2575 | Invokes "svn update" at the root of each working copy specified by @targets. If |
---|
| 2576 | @targets is an empty list, the function adds the current working directory to |
---|
| 2577 | it. $option{'non-interactive'}, $option{quiet}, $option{revision} determines the |
---|
| 2578 | options (of the same name) that are passed to "svn update". If |
---|
| 2579 | $option{st_check_handler} is set, it should be a CODE reference, and will be |
---|
| 2580 | called with ($name, $target_list_ref, $status_list_ref), where $name is |
---|
| 2581 | 'update', $target_list_ref is \@targets and $status_list_ref is an ARRAY |
---|
| 2582 | reference to the output returned by "svn status -u" on the @targets. This can be |
---|
| 2583 | used for the application to display the working copy update status to the user |
---|
| 2584 | before prompting him/her to continue. The return value of |
---|
| 2585 | $option{st_check_handler} is ignored. |
---|
| 2586 | |
---|
| 2587 | =back |
---|
| 2588 | |
---|
| 2589 | =head1 DIAGNOSTICS |
---|
| 2590 | |
---|
| 2591 | The following exceptions can be raised: |
---|
| 2592 | |
---|
| 2593 | =over 4 |
---|
| 2594 | |
---|
| 2595 | =item Fcm::Cm::Abort |
---|
| 2596 | |
---|
| 2597 | This exception @ISA L<Fcm::Exception|Fcm::Exception>. It is raised if a command |
---|
| 2598 | is aborted for some reason. The $e->get_code() method can be used to retrieve an |
---|
| 2599 | error code, which can be one of the following: |
---|
| 2600 | |
---|
| 2601 | =over 4 |
---|
| 2602 | |
---|
| 2603 | =item $e->FAIL |
---|
| 2604 | |
---|
| 2605 | The command aborts because of a failure. |
---|
| 2606 | |
---|
| 2607 | =item $e->NULL |
---|
| 2608 | |
---|
| 2609 | The command aborts because it will result in no change. |
---|
| 2610 | |
---|
| 2611 | =item $e->USER |
---|
| 2612 | |
---|
| 2613 | The command aborts because of an action by the user. |
---|
| 2614 | |
---|
| 2615 | =back |
---|
| 2616 | |
---|
| 2617 | =item Fcm::Cm::Exception |
---|
| 2618 | |
---|
| 2619 | This exception @ISA L<Fcm::Abort|Fcm::Abort>. It is raised if a command fails |
---|
| 2620 | with a known reason. The $e->get_targets() method can be used to retrieve a list |
---|
| 2621 | of targets/resources associated with this exception. The $e->get_code() method |
---|
| 2622 | can be used to retrieve an error code, which can be one of the following: |
---|
| 2623 | |
---|
| 2624 | =over 4 |
---|
| 2625 | |
---|
| 2626 | =item $e->CHDIR |
---|
| 2627 | |
---|
| 2628 | Fails to change directory to a target. |
---|
| 2629 | |
---|
| 2630 | =item $e->INVALID_BRANCH |
---|
| 2631 | |
---|
| 2632 | A target is not a valid branch URL in the standard FCM project layout. |
---|
| 2633 | |
---|
| 2634 | =item $e->INVALID_PROJECT |
---|
| 2635 | |
---|
| 2636 | A target is not a valid project URL in the standard FCM project layout. |
---|
| 2637 | |
---|
| 2638 | =item $e->INVALID_TARGET |
---|
| 2639 | |
---|
| 2640 | A target is not a valid Subversion URL or working copy. |
---|
| 2641 | |
---|
| 2642 | =item $e->INVALID_URL |
---|
| 2643 | |
---|
| 2644 | A target is not a valid Subversion URL. |
---|
| 2645 | |
---|
| 2646 | =item $e->INVALID_WC |
---|
| 2647 | |
---|
| 2648 | A target is not a valid Subversion working copy. |
---|
| 2649 | |
---|
| 2650 | =item $e->MERGE_REV_INVALID |
---|
| 2651 | |
---|
| 2652 | An invalid revision (target element 0) is specified for a merge. |
---|
| 2653 | |
---|
| 2654 | =item $e->MERGE_SELF |
---|
| 2655 | |
---|
| 2656 | Attempt to merge a URL (target element 0) to its own working copy (target |
---|
| 2657 | element 1). |
---|
| 2658 | |
---|
| 2659 | =item $e->MERGE_UNRELATED |
---|
| 2660 | |
---|
| 2661 | The merge target (target element 0) is not directly related to the merge source |
---|
| 2662 | (target element 1). |
---|
| 2663 | |
---|
| 2664 | =item $e->MERGE_UNSAFE |
---|
| 2665 | |
---|
| 2666 | A merge source (target element 0) contains changes outside the target |
---|
| 2667 | sub-directory. |
---|
| 2668 | |
---|
| 2669 | =item $e->MKPATH |
---|
| 2670 | |
---|
| 2671 | Fail to create a directory (target element 0) recursively. |
---|
| 2672 | |
---|
| 2673 | =item $e->NOT_EXIST |
---|
| 2674 | |
---|
| 2675 | A target does not exist. |
---|
| 2676 | |
---|
| 2677 | =item $e->PARENT_NOT_EXIST |
---|
| 2678 | |
---|
| 2679 | The parent of the target no longer exists. |
---|
| 2680 | |
---|
| 2681 | =item $e->RMTREE |
---|
| 2682 | |
---|
| 2683 | Fail to remove a directory (target element 0) recursively. |
---|
| 2684 | |
---|
| 2685 | =item $e->SWITCH_UNSAFE |
---|
| 2686 | |
---|
| 2687 | A merge template exists in the commit message file (target element 0) in a |
---|
| 2688 | working copy target. |
---|
| 2689 | |
---|
| 2690 | =item $e->WC_EXIST |
---|
| 2691 | |
---|
| 2692 | The target working copy already exists. |
---|
| 2693 | |
---|
| 2694 | =item $e->WC_INVALID_BRANCH |
---|
| 2695 | |
---|
| 2696 | The URL of the target working copy is not a valid branch URL in the standard FCM |
---|
| 2697 | project layout. |
---|
| 2698 | |
---|
| 2699 | =item $e->WC_URL_NOT_EXIST |
---|
| 2700 | |
---|
| 2701 | The URL of the target working copy no longer exists at the HEAD revision. |
---|
| 2702 | |
---|
| 2703 | =back |
---|
| 2704 | |
---|
| 2705 | =back |
---|
| 2706 | |
---|
| 2707 | =head1 TO DO |
---|
| 2708 | |
---|
| 2709 | Reintegrate with L<Fcm::CmUrl|Fcm::CmUrl> and L<Fcm::CmBranch|Fcm::CmBranch>, |
---|
| 2710 | but separate this module into the CLI part and the CM part. Expose the remaining |
---|
| 2711 | CM functions when this is done. |
---|
| 2712 | |
---|
| 2713 | Use L<SVN::Client|SVN::Client> to interface with Subversion. |
---|
| 2714 | |
---|
| 2715 | Move C<mkpatch> out of this module. |
---|
| 2716 | |
---|
| 2717 | =head1 COPYRIGHT |
---|
| 2718 | |
---|
| 2719 | E<169> Crown copyright Met Office. All rights reserved. |
---|
| 2720 | |
---|
| 2721 | =cut |
---|