[1980] | 1 | # ------------------------------------------------------------------------------ |
---|
| 2 | # NAME |
---|
| 3 | # Fcm::CmCommitMessage |
---|
| 4 | # |
---|
| 5 | # DESCRIPTION |
---|
| 6 | # This class contains methods to read, write and edit the commit message file |
---|
| 7 | # in a working copy. |
---|
| 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 | |
---|
| 15 | package Fcm::CmCommitMessage; |
---|
| 16 | @ISA = qw(Fcm::Base); |
---|
| 17 | |
---|
| 18 | # Standard pragma |
---|
| 19 | use warnings; |
---|
| 20 | use strict; |
---|
| 21 | |
---|
| 22 | # Standard modules |
---|
| 23 | use Carp; |
---|
| 24 | use Cwd; |
---|
| 25 | use File::Spec; |
---|
| 26 | use File::Temp qw/tempfile/; |
---|
| 27 | |
---|
| 28 | # FCM component modules |
---|
| 29 | use Fcm::Base; |
---|
| 30 | use Fcm::Util qw/e_report run_command/; |
---|
| 31 | |
---|
| 32 | # List of property methods for this class |
---|
| 33 | my @scalar_properties = ( |
---|
| 34 | 'auto_mesg', # the automatically inserted part of a commit message |
---|
| 35 | 'base', # the base name of the commit message file |
---|
| 36 | 'dir', # the directory container of the commit message file |
---|
| 37 | 'ignore_mesg', # the ignored part of a commit message |
---|
| 38 | 'user_mesg', # the user defined part of a commit message |
---|
| 39 | ); |
---|
| 40 | |
---|
| 41 | # Commit log delimiter messages |
---|
| 42 | my $log_delimiter = '--Add your commit message ABOVE - ' . |
---|
| 43 | 'do not alter this line or those below--'; |
---|
| 44 | my $auto_delimiter = '--FCM message (will be inserted automatically)--'; |
---|
| 45 | my $auto_delimiter_old = '--This line will be ignored and those below ' . |
---|
| 46 | 'will be inserted automatically--'; |
---|
| 47 | my $status_delimiter = '--Change summary ' . |
---|
| 48 | '(not part of commit message)--'; |
---|
| 49 | my $status_delimiter_old = '--This line, and those below, will be ignored--'; |
---|
| 50 | |
---|
| 51 | # ------------------------------------------------------------------------------ |
---|
| 52 | # SYNOPSIS |
---|
| 53 | # $obj = Fcm::CmCommitMessage->new (); |
---|
| 54 | # |
---|
| 55 | # DESCRIPTION |
---|
| 56 | # This method constructs a new instance of the Fcm::CmCommitMessage class. |
---|
| 57 | # ------------------------------------------------------------------------------ |
---|
| 58 | |
---|
| 59 | sub new { |
---|
| 60 | my $this = shift; |
---|
| 61 | my %args = @_; |
---|
| 62 | my $class = ref $this || $this; |
---|
| 63 | |
---|
| 64 | my $self = Fcm::Base->new (%args); |
---|
| 65 | |
---|
| 66 | $self->{$_} = undef for (@scalar_properties); |
---|
| 67 | |
---|
| 68 | bless $self, $class; |
---|
| 69 | return $self; |
---|
| 70 | } |
---|
| 71 | |
---|
| 72 | # ------------------------------------------------------------------------------ |
---|
| 73 | # SYNOPSIS |
---|
| 74 | # $value = $obj->X; |
---|
| 75 | # $obj->X ($value); |
---|
| 76 | # |
---|
| 77 | # DESCRIPTION |
---|
| 78 | # Details of these properties are explained in @scalar_properties. |
---|
| 79 | # ------------------------------------------------------------------------------ |
---|
| 80 | |
---|
| 81 | for my $name (@scalar_properties) { |
---|
| 82 | no strict 'refs'; |
---|
| 83 | |
---|
| 84 | *$name = sub { |
---|
| 85 | my $self = shift; |
---|
| 86 | |
---|
| 87 | # Argument specified, set property to specified argument |
---|
| 88 | if (@_) { |
---|
| 89 | $self->{$name} = $_[0]; |
---|
| 90 | } |
---|
| 91 | |
---|
| 92 | # Default value for property |
---|
| 93 | if (not defined $self->{$name}) { |
---|
| 94 | if ($name eq 'base') { |
---|
| 95 | # Reference to an array |
---|
| 96 | $self->{$name} = '#commit_message#'; |
---|
| 97 | |
---|
| 98 | } elsif ($name eq 'dir') { |
---|
| 99 | # Current working directory |
---|
| 100 | $self->{$name} = &cwd (); |
---|
| 101 | |
---|
| 102 | } elsif ($name =~ /_mesg$/) { |
---|
| 103 | # Reference to an array |
---|
| 104 | $self->{$name} = []; |
---|
| 105 | } |
---|
| 106 | } |
---|
| 107 | |
---|
| 108 | return $self->{$name}; |
---|
| 109 | } |
---|
| 110 | } |
---|
| 111 | |
---|
| 112 | # ------------------------------------------------------------------------------ |
---|
| 113 | # SYNOPSIS |
---|
| 114 | # $file = $obj->file; |
---|
| 115 | # $obj->file ($file); |
---|
| 116 | # |
---|
| 117 | # DESCRIPTION |
---|
| 118 | # This method returns the full name of the commit message file. If an |
---|
| 119 | # argument is specified, the file is reset using the value of the argument. |
---|
| 120 | # ------------------------------------------------------------------------------ |
---|
| 121 | |
---|
| 122 | sub file { |
---|
| 123 | my ($self, $file) = @_; |
---|
| 124 | |
---|
| 125 | if ($file) { |
---|
| 126 | $self->dir (dirname ($file)); |
---|
| 127 | $self->base (basename ($file)); |
---|
| 128 | } |
---|
| 129 | |
---|
| 130 | return File::Spec->catfile ($self->dir, $self->base); |
---|
| 131 | } |
---|
| 132 | |
---|
| 133 | # ------------------------------------------------------------------------------ |
---|
| 134 | # SYNOPSIS |
---|
| 135 | # ($user, $auto) = $obj->read_file (); |
---|
| 136 | # |
---|
| 137 | # DESCRIPTION |
---|
| 138 | # This function reads from the commit log message file. It resets the user |
---|
| 139 | # and the automatic messages after reading the file. It returns the message |
---|
| 140 | # back in two array references. |
---|
| 141 | # ------------------------------------------------------------------------------ |
---|
| 142 | |
---|
| 143 | sub read_file { |
---|
| 144 | my $self = shift; |
---|
| 145 | |
---|
| 146 | my @user = (); |
---|
| 147 | my @auto = (); |
---|
| 148 | my $file = $self->file; |
---|
| 149 | |
---|
| 150 | if (-r $file) { |
---|
| 151 | open FILE, '<', $file or croak 'Cannot open ', $file, '(', $!, '), abort'; |
---|
| 152 | |
---|
| 153 | my $in_auto = 0; |
---|
| 154 | while (<FILE>) { |
---|
| 155 | |
---|
| 156 | next if (index ($_, $log_delimiter) == 0); |
---|
| 157 | |
---|
| 158 | if (index ($_, $status_delimiter) == 0 || |
---|
| 159 | index ($_, $status_delimiter_old) == 0) { |
---|
| 160 | # Ignore after the ignore delimiter |
---|
| 161 | last; |
---|
| 162 | } |
---|
| 163 | |
---|
| 164 | if (index ($_, $auto_delimiter) == 0 || |
---|
| 165 | index ($_, $auto_delimiter_old) == 0) { |
---|
| 166 | # Beginning of the automatically inserted message |
---|
| 167 | $in_auto = 1; |
---|
| 168 | next; |
---|
| 169 | } |
---|
| 170 | |
---|
| 171 | if ($in_auto) { |
---|
| 172 | push @auto, $_; |
---|
| 173 | |
---|
| 174 | } else { |
---|
| 175 | push @user, $_; |
---|
| 176 | } |
---|
| 177 | } |
---|
| 178 | |
---|
| 179 | close FILE; |
---|
| 180 | |
---|
| 181 | $self->user_mesg (\@user); |
---|
| 182 | $self->auto_mesg (\@auto); |
---|
| 183 | } |
---|
| 184 | |
---|
| 185 | return (\@user, \@auto); |
---|
| 186 | } |
---|
| 187 | |
---|
| 188 | # ------------------------------------------------------------------------------ |
---|
| 189 | # SYNOPSIS |
---|
| 190 | # $obj->write_file (); |
---|
| 191 | # |
---|
| 192 | # DESCRIPTION |
---|
| 193 | # This function writes to the commit log message file based on the content of |
---|
| 194 | # the user defined message, and the automatically inserted message. |
---|
| 195 | # ------------------------------------------------------------------------------ |
---|
| 196 | |
---|
| 197 | sub write_file { |
---|
| 198 | my $self = shift; |
---|
| 199 | my %args = @_; |
---|
| 200 | |
---|
| 201 | my @user = @{ $self->user_mesg }; |
---|
| 202 | my @auto = @{ $self->auto_mesg }; |
---|
| 203 | my $file = $self->file; |
---|
| 204 | |
---|
| 205 | open FILE, '>', $file or die 'Cannot open ', $file, '(', $!, '), abort'; |
---|
| 206 | print FILE @user; |
---|
| 207 | print FILE $log_delimiter, "\n", $auto_delimiter, "\n", @auto if @auto; |
---|
| 208 | close FILE or croak 'Cannot close ', $file, '(', $!, '), abort'; |
---|
| 209 | |
---|
| 210 | return; |
---|
| 211 | } |
---|
| 212 | |
---|
| 213 | # ------------------------------------------------------------------------------ |
---|
| 214 | # SYNOPSIS |
---|
| 215 | # $file = $obj->edit_file ([TEMP => 1,] [BATCH => 1,]); |
---|
| 216 | # |
---|
| 217 | # DESCRIPTION |
---|
| 218 | # This function normally triggers an editor for editing the commit message. |
---|
| 219 | # If TEMP is set, it edits a temporary file. Otherwise, it edits the current |
---|
| 220 | # commit message file. It resets the user defined message on success. Returns |
---|
| 221 | # the name of the commit log file. Do not start the editor if BATCH is set. |
---|
| 222 | # ------------------------------------------------------------------------------ |
---|
| 223 | |
---|
| 224 | sub edit_file { |
---|
| 225 | my $self = shift; |
---|
| 226 | my %args = @_; |
---|
| 227 | my $temp = exists $args{TEMP} ? $args{TEMP} : 0; |
---|
| 228 | my $batch = exists $args{BATCH} ? $args{BATCH} : 0; |
---|
| 229 | |
---|
| 230 | my @user = @{ $self->user_mesg }; |
---|
| 231 | my @auto = @{ $self->auto_mesg }; |
---|
| 232 | my @ignore = @{ $self->ignore_mesg }; |
---|
| 233 | my $file = $self->file; |
---|
| 234 | |
---|
| 235 | if ($temp) { |
---|
| 236 | my $fh; |
---|
| 237 | ($fh, $file) = tempfile (SUFFIX => ".fcm", UNLINK => 1); |
---|
| 238 | close $fh; |
---|
| 239 | } |
---|
| 240 | |
---|
| 241 | # Add original or code driven message and status information to the file |
---|
| 242 | my $select = select; |
---|
| 243 | open FILE, '>', $file or croak 'Cannot open ', $file, ' (', $!, '), abort'; |
---|
| 244 | select FILE; |
---|
| 245 | |
---|
| 246 | print @user; |
---|
| 247 | print (@auto || @user ? '' : "\n"); |
---|
| 248 | print $log_delimiter, "\n"; |
---|
| 249 | print $auto_delimiter, "\n", @auto, "\n" if @auto; |
---|
| 250 | print $status_delimiter, "\n\n"; |
---|
| 251 | print @ignore if @ignore; |
---|
| 252 | |
---|
| 253 | close FILE or die 'Cannot close ', $file, ' (', $!, '), abort'; |
---|
| 254 | select $select; |
---|
| 255 | |
---|
| 256 | if (not $batch) { |
---|
| 257 | # Select editor |
---|
| 258 | my $editor = 'nedit'; |
---|
| 259 | |
---|
| 260 | if ($ENV{'SVN_EDITOR'}) { |
---|
| 261 | $editor = $ENV{'SVN_EDITOR'}; |
---|
| 262 | |
---|
| 263 | } elsif ($ENV{'VISUAL'}) { |
---|
| 264 | $editor = $ENV{'VISUAL'}; |
---|
| 265 | |
---|
| 266 | } elsif ($ENV{'EDITOR'}) { |
---|
| 267 | $editor = $ENV{'EDITOR'}; |
---|
| 268 | } |
---|
| 269 | |
---|
| 270 | # Execute command to start the editor |
---|
| 271 | print 'Starting ', $editor, ' to edit commit message ...', "\n"; |
---|
| 272 | &run_command ([split (/\s+/, $editor), $file]); |
---|
| 273 | } |
---|
| 274 | |
---|
| 275 | # Read the edited file, and extract user log message from it |
---|
| 276 | open FILE, '<', $file or croak 'Cannot open ', $file, ' (', $!, '), abort'; |
---|
| 277 | my (@log); |
---|
| 278 | my $delimiter_found = 0; |
---|
| 279 | |
---|
| 280 | while (<FILE>) { |
---|
| 281 | if (index ($_, $log_delimiter) == 0) { |
---|
| 282 | $delimiter_found = 1; |
---|
| 283 | last; |
---|
| 284 | } |
---|
| 285 | push @log, $_; |
---|
| 286 | } |
---|
| 287 | |
---|
| 288 | close FILE; |
---|
| 289 | |
---|
| 290 | # Ensure log delimiter line was not altered |
---|
| 291 | e_report 'Error: the line "', $log_delimiter, '" has been altered, abort.' |
---|
| 292 | if not $delimiter_found; |
---|
| 293 | |
---|
| 294 | # Check for empty commit log |
---|
| 295 | e_report 'Error: log message unchanged or not specified, abort.' |
---|
| 296 | if join (' ', (@log, @auto)) =~ /^\s*$/; |
---|
| 297 | |
---|
| 298 | # Echo the commit message to standard output |
---|
| 299 | my $separator = '-' x 80 . "\n"; |
---|
| 300 | print 'Change summary:', "\n"; |
---|
| 301 | print $separator, @ignore, $separator; |
---|
| 302 | print 'Commit message is as follows:', "\n"; |
---|
| 303 | print $separator, @log, @auto, $separator; |
---|
| 304 | |
---|
| 305 | open FILE, '>', $file or croak 'Cannot open ', $file, ' (', $!, '), abort'; |
---|
| 306 | print FILE @log, @auto; |
---|
| 307 | close FILE or croak 'Cannot close ', $file, ' (', $!, '), abort'; |
---|
| 308 | |
---|
| 309 | # Reset the array for the user specified log message |
---|
| 310 | $self->user_mesg (\@log); |
---|
| 311 | |
---|
| 312 | return $file; |
---|
| 313 | } |
---|
| 314 | |
---|
| 315 | # ------------------------------------------------------------------------------ |
---|
| 316 | |
---|
| 317 | 1; |
---|
| 318 | |
---|
| 319 | __END__ |
---|