| 1 |
wakaba |
1.1 |
#!/usr/bin/perl
|
| 2 |
|
|
use lib q#../lib#;
|
| 3 |
|
|
use strict;
|
| 4 |
|
|
our $VERSION=do{my @r=(q$Revision: 1.40 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
|
| 5 |
|
|
require RCSFormat;
|
| 6 |
|
|
require Getopt::Long;
|
| 7 |
|
|
require IO::File;
|
| 8 |
|
|
|
| 9 |
|
|
|
| 10 |
|
|
sub rcsdate ($) {
|
| 11 |
|
|
my ($s, $min, $h, $d, $m, $y) = gmtime shift;
|
| 12 |
|
|
$y += 1900 unless $y < 100 and $y > 0;
|
| 13 |
|
|
$m++;
|
| 14 |
|
|
sprintf '%02d.%02d.%02d.%02d.%02d.%02d', $y, $m, $d, $h, $min, $s;
|
| 15 |
|
|
}
|
| 16 |
|
|
|
| 17 |
|
|
|
| 18 |
|
|
sub commit_file ($%) {
|
| 19 |
|
|
my ($filename, %opt) = @_;
|
| 20 |
|
|
my $rcs = new RCSFormat;
|
| 21 |
|
|
my $rev;
|
| 22 |
|
|
|
| 23 |
|
|
$/ = undef;
|
| 24 |
|
|
my $rcsfilename = $opt{module_directory} . '/' . ($opt{repository_filename} || $filename) . ',v';
|
| 25 |
|
|
my $rcsfile_modified = 0;
|
| 26 |
|
|
my $current_text;
|
| 27 |
|
|
my $currev;
|
| 28 |
|
|
if (-e $rcsfilename) {
|
| 29 |
|
|
my $rcsfile = new IO::File $rcsfilename, 'r' or die "$0: $rcsfilename: $!";
|
| 30 |
|
|
binmode $rcsfile;
|
| 31 |
|
|
$rcs->parse_text (scalar <$rcsfile>);
|
| 32 |
|
|
$rcsfile->close;
|
| 33 |
|
|
|
| 34 |
|
|
$currev = rcsrevision->new ($rcs->{admin}->{head});
|
| 35 |
|
|
$rev = $currev->next_revision;
|
| 36 |
|
|
|
| 37 |
|
|
$current_text = $rcs->{deltatext}->{$currev}->{text};
|
| 38 |
|
|
|
| 39 |
|
|
require File::Temp;
|
| 40 |
|
|
my $current_file = new File::Temp;
|
| 41 |
|
|
my (undef, $diff_filemame) = File::Temp::tempfile ('DIFFXXXX',
|
| 42 |
|
|
DIR => File::Temp::tempdir (),
|
| 43 |
|
|
OPEN => 0);
|
| 44 |
|
|
$current_file->print ($current_text);
|
| 45 |
|
|
require IPC::Open2;
|
| 46 |
|
|
IPC::Open2::open2 (my $diffin, my $diffout, $opt{diff_command}, @{$opt{diff_option}},
|
| 47 |
|
|
$filename => $current_file->filename)
|
| 48 |
|
|
or die "$0: diff: $!";
|
| 49 |
|
|
binmode $diffin;
|
| 50 |
|
|
my $difftext = <$diffin>;
|
| 51 |
|
|
if (length $difftext) {
|
| 52 |
|
|
$rcs->{delta}->{$rev}->{next} = $currev;
|
| 53 |
|
|
$rcs->{deltatext}->{$currev}->{text} = $difftext;
|
| 54 |
|
|
$rcsfile_modified = 1;
|
| 55 |
|
|
} else {
|
| 56 |
|
|
undef $rev;
|
| 57 |
|
|
}
|
| 58 |
|
|
} else {
|
| 59 |
|
|
my @src_file = sort {$a cmp $b} grep /\.\d{14,}$/, glob $filename.'.*';
|
| 60 |
|
|
push @src_file, $filename if -e $filename;
|
| 61 |
|
|
$rev = new rcsrevision 1.1;
|
| 62 |
|
|
if (@src_file > 1) {
|
| 63 |
|
|
require Time::Local;
|
| 64 |
|
|
require IPC::Open2;
|
| 65 |
|
|
for my $i (1..$#src_file) {
|
| 66 |
|
|
$currev = $rev;
|
| 67 |
|
|
$rev = $currev->next_revision;
|
| 68 |
|
|
|
| 69 |
|
|
STDERR->print ("$0: $filename: $src_file[$i-1]...\n");
|
| 70 |
|
|
local $opt{commit_time} = $opt{commit_time};
|
| 71 |
|
|
if ($src_file[$i-1] =~ /\.(\d+)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)$/) {
|
| 72 |
|
|
$opt{commit_time} = Time::Local::timegm_nocheck ($6, $5, $4, $3, $2-1, $1-1900);
|
| 73 |
|
|
}
|
| 74 |
|
|
|
| 75 |
|
|
IPC::Open2::open2 (my $diffin, my $diffout, $opt{diff_command}, @{$opt{diff_option}},
|
| 76 |
|
|
$src_file[$i] => $src_file[$i-1])
|
| 77 |
|
|
or die "$0: diff: $!";
|
| 78 |
|
|
binmode $diffin;
|
| 79 |
|
|
my $difftext = <$diffin>;
|
| 80 |
|
|
if (length $difftext) {
|
| 81 |
|
|
$rcs->{delta}->{$rev}->{next} = $currev;
|
| 82 |
|
|
$rcs->{delta}->{$currev}->{date} = rcsdate $opt{commit_time} || [stat $filename]->[9];
|
| 83 |
|
|
$rcs->{delta}->{$currev}->{author} = $opt{author};
|
| 84 |
|
|
$rcs->{delta}->{$currev}->{state} = 'Exp';
|
| 85 |
|
|
$rcs->{deltatext}->{$currev}->{log} = $opt{commit_log};
|
| 86 |
|
|
$rcs->{deltatext}->{$currev}->{text} = $difftext;
|
| 87 |
|
|
$rcsfile_modified = 1;
|
| 88 |
|
|
} else {
|
| 89 |
|
|
$rev = $currev;
|
| 90 |
|
|
}
|
| 91 |
|
|
}
|
| 92 |
|
|
}
|
| 93 |
|
|
if (@src_file) {
|
| 94 |
|
|
$filename = pop @src_file;
|
| 95 |
|
|
} else {
|
| 96 |
|
|
STDERR->print ("$0: $filename: No target file\n");
|
| 97 |
|
|
return 0;
|
| 98 |
|
|
}
|
| 99 |
|
|
}
|
| 100 |
|
|
|
| 101 |
|
|
if (defined $rev) {
|
| 102 |
|
|
$rcsfile_modified = 1;
|
| 103 |
|
|
my $new_file = new IO::File $filename, 'r' or die "$0: $filename: $!";
|
| 104 |
|
|
binmode $new_file;
|
| 105 |
|
|
$rcs->{deltatext}->{$rev}->{text} = <$new_file>;
|
| 106 |
|
|
$new_file->close;
|
| 107 |
|
|
|
| 108 |
|
|
if ($filename =~ /\.(\d+)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)$/) {
|
| 109 |
|
|
require Time::Local;
|
| 110 |
|
|
$rcs->{delta}->{$rev}->{date} = rcsdate Time::Local::timegm_nocheck ($6, $5, $4, $3, $2-1, $1-1900);
|
| 111 |
|
|
} else {
|
| 112 |
|
|
$rcs->{delta}->{$rev}->{date} = rcsdate $opt{commit_time} || [stat $filename]->[9];
|
| 113 |
|
|
}
|
| 114 |
|
|
$rcs->{delta}->{$rev}->{author} = $opt{author};
|
| 115 |
|
|
$rcs->{delta}->{$rev}->{state} = 'Exp';
|
| 116 |
|
|
$rcs->{deltatext}->{$rev}->{log} = $opt{commit_log};
|
| 117 |
|
|
|
| 118 |
|
|
$rcs->{admin}->{head} = $rev;
|
| 119 |
|
|
$rcs->{admin}->{strict} ||= 1;
|
| 120 |
|
|
$rcs->{admin}->{comment} ||= '# ';
|
| 121 |
|
|
$rcs->{admin}->{expand} ||= $opt{keyword_expand};
|
| 122 |
|
|
}
|
| 123 |
|
|
|
| 124 |
|
|
if ($rcsfile_modified) {
|
| 125 |
|
|
my $rcsfile = new IO::File $rcsfilename, 'w' or die "$0: $rcsfilename: $!";
|
| 126 |
|
|
binmode $rcsfile;
|
| 127 |
|
|
$rcsfile->print ($rcs->stringify);
|
| 128 |
|
|
$rcsfile->close;
|
| 129 |
|
|
return 1;
|
| 130 |
|
|
} else {
|
| 131 |
|
|
return 0;
|
| 132 |
|
|
}
|
| 133 |
|
|
}
|
| 134 |
|
|
|
| 135 |
|
|
|
| 136 |
|
|
package rcsrevision;
|
| 137 |
|
|
use overload
|
| 138 |
|
|
'+' => sub {$_[0]->clone->plus ($_[1])},
|
| 139 |
|
|
'+=' => 'plus',
|
| 140 |
|
|
'""' => 'stringify',
|
| 141 |
|
|
fallback => 1;
|
| 142 |
|
|
|
| 143 |
|
|
sub new ($$) {
|
| 144 |
|
|
my $class = shift;
|
| 145 |
|
|
bless [split /\./, shift || '1.1'], $class;
|
| 146 |
|
|
}
|
| 147 |
|
|
|
| 148 |
|
|
sub plus ($$) {
|
| 149 |
|
|
my $self = shift;
|
| 150 |
|
|
my $p = shift;
|
| 151 |
|
|
$p = [split /\./, $p] unless ref $p;
|
| 152 |
|
|
for (0..$#$p) {
|
| 153 |
|
|
$self->[$_] += $p->[$_];
|
| 154 |
|
|
}
|
| 155 |
|
|
$self;
|
| 156 |
|
|
}
|
| 157 |
|
|
|
| 158 |
|
|
sub next_revision ($$) {
|
| 159 |
|
|
my $clone = shift->clone;
|
| 160 |
|
|
$clone->[$#$clone]++;
|
| 161 |
|
|
$clone;
|
| 162 |
|
|
}
|
| 163 |
|
|
|
| 164 |
|
|
sub stringify ($) {
|
| 165 |
|
|
join '.', @{+shift};
|
| 166 |
|
|
}
|
| 167 |
|
|
|
| 168 |
|
|
sub clone ($) {
|
| 169 |
|
|
bless [@{$_[0]}], ref $_[0];
|
| 170 |
|
|
}
|
| 171 |
|
|
|
| 172 |
|
|
package main;
|
| 173 |
|
|
MAIN: {
|
| 174 |
|
|
my %opt = (
|
| 175 |
|
|
author => $ENV{USER} || 'knitmodule',
|
| 176 |
|
|
diff_command => 'diff',
|
| 177 |
|
|
diff_option => '--rcs',
|
| 178 |
|
|
expand => 'b',
|
| 179 |
|
|
module_directory => q<CVS>,
|
| 180 |
|
|
recursive => 1,
|
| 181 |
|
|
);
|
| 182 |
|
|
|
| 183 |
|
|
Getopt::Long::GetOptions (
|
| 184 |
|
|
'author=s' => \$opt{author},
|
| 185 |
|
|
'commit-date=s' => \$opt{commit_time},
|
| 186 |
|
|
'diff-command=s' => \$opt{diff_command},
|
| 187 |
|
|
'diff-option=s' => \$opt{diff_option},
|
| 188 |
|
|
'm=s' => \$opt{commit_log},
|
| 189 |
|
|
'd=s' => \$opt{module_directory},
|
| 190 |
|
|
'k=s' => \$opt{keyword_expand},
|
| 191 |
|
|
'recursive' => \$opt{recursive},
|
| 192 |
|
|
'repository-filename=s' => \$opt{repository_filename},
|
| 193 |
|
|
);
|
| 194 |
|
|
## BUG: This code doesn't cope w/ quoted argument
|
| 195 |
|
|
$opt{diff_option} = [split /\s+/, $opt{diff_option}];
|
| 196 |
|
|
if ($opt{commit_time}) {
|
| 197 |
|
|
require Time::Local;
|
| 198 |
|
|
$opt{commit_time} =~ /(\d+)-?(\d+)?-?(\d+)?[T\s]?(\d+)?:?(\d+)?:?(\d+)?([+-]\d+)?:?(\d+)/;
|
| 199 |
|
|
$opt{commit_time} = Time::Local::timegm_nocheck ($6, $5, $4, $3, $2-1, $1-1900) - $7 * 3600 - $8;
|
| 200 |
|
|
}
|
| 201 |
|
|
|
| 202 |
|
|
die "$0: Filename not specified" unless @ARGV;
|
| 203 |
|
|
for (map {glob} @ARGV) {
|
| 204 |
|
|
STDERR->print ("$0: $_...");
|
| 205 |
|
|
if (-d $_) {
|
| 206 |
|
|
commit_directory ($_, %opt) if $opt{recursive};
|
| 207 |
|
|
} elsif (commit_file ($_, %opt)) {
|
| 208 |
|
|
STDERR->print ("done\n");
|
| 209 |
|
|
} else {
|
| 210 |
|
|
STDERR->print ("not modified\n");
|
| 211 |
|
|
}
|
| 212 |
|
|
}
|
| 213 |
|
|
}
|
| 214 |
|
|
|
| 215 |
|
|
sub commit_directory ($%) {
|
| 216 |
|
|
my ($dir_name, %opt) = @_;
|
| 217 |
|
|
require IO::Dir;
|
| 218 |
|
|
my $dir = new IO::Dir $dir_name or die "$0: $dir_name: $!";
|
| 219 |
|
|
STDERR->print ("$0: Directory $dir_name...\n");
|
| 220 |
|
|
mkdir $opt{module_directory}.'/'.$dir_name
|
| 221 |
|
|
or die "$0: $opt{module_directory}/$dir_name: $!"
|
| 222 |
|
|
unless -e $opt{module_directory}.'/'.$dir_name;
|
| 223 |
|
|
while (defined ($_ = $dir->read)) {
|
| 224 |
|
|
next if $_ eq '..' or $_ eq '.';
|
| 225 |
|
|
STDERR->print ("$0: $dir_name/$_...");
|
| 226 |
|
|
if (-d $_) {
|
| 227 |
|
|
commit_directory ($dir_name.'/'.$_, %opt) if $opt{recursive};
|
| 228 |
|
|
} elsif (commit_file ($dir_name.'/'.$_, %opt)) {
|
| 229 |
|
|
STDERR->print ("done\n");
|
| 230 |
|
|
} else {
|
| 231 |
|
|
STDERR->print ("not modified\n");
|
| 232 |
|
|
}
|
| 233 |
|
|
}
|
| 234 |
|
|
return 1;
|
| 235 |
|
|
}
|
| 236 |
|
|
|
| 237 |
|
|
__END__
|
| 238 |
|
|
|
| 239 |
|
|
=head1 NAME
|
| 240 |
|
|
|
| 241 |
|
|
knitmodule - Generating RCS format history file from variant files
|
| 242 |
|
|
|
| 243 |
|
|
=head1 SYNOPSIS
|
| 244 |
|
|
|
| 245 |
|
|
knitmodule.pl [--author=author-name] [--commit-date=rfc3339-date] [--diff-command=diff] [--diff-option=diff-option] [-m "Commit log message"] [-d repository-directory] [-k keyword-substition] [--recursive] [--repository-filename=filename] target-file1 [target-file2, ...]
|
| 246 |
|
|
|
| 247 |
|
|
=head1 DESCRIPTION
|
| 248 |
|
|
|
| 249 |
|
|
C<knitmodule> generates RCS format history file(s) from source file(s) that is/are
|
| 250 |
|
|
version variant of something. RCS file(s) is/are created in directory specified by
|
| 251 |
|
|
C<-d> option, that defaults to C<./CVS>, with filename specified by
|
| 252 |
|
|
C<--repository-filename>, which defaults to C<target-file,v>. If RCS file(s)
|
| 253 |
|
|
already exist(s) in repository, target file is commited as the latest version
|
| 254 |
|
|
(in trunk). Otherwise, new repository file is created.
|
| 255 |
|
|
C<target-file> might be a directory, in case C<--recursive> option specified.
|
| 256 |
|
|
|
| 257 |
|
|
=head2 Target File With Date Suffixed Filename
|
| 258 |
|
|
|
| 259 |
|
|
When RCS file corresponding to the target file does not found,
|
| 260 |
|
|
"date suffixed filename" files in the same directory as target file are collected
|
| 261 |
|
|
and used to construct new repository file. "Date suffix" consists of a FULL STOP
|
| 262 |
|
|
(.) and more than 13 DIGITs, representing date-time in UTC. "Date suffixed" variants
|
| 263 |
|
|
are sorted by its date and logged as revisions in RCS file, just before target file
|
| 264 |
|
|
is committed (as the latest version).
|
| 265 |
|
|
|
| 266 |
|
|
=head1 BUGS
|
| 267 |
|
|
|
| 268 |
|
|
= over 4
|
| 269 |
|
|
|
| 270 |
|
|
=item *
|
| 271 |
|
|
|
| 272 |
|
|
This script does not support branches yet, although it does not break
|
| 273 |
|
|
existing branches.
|
| 274 |
|
|
|
| 275 |
|
|
=item *
|
| 276 |
|
|
|
| 277 |
|
|
C<--help> should display help message.
|
| 278 |
|
|
|
| 279 |
|
|
=head1 SEE ALSO
|
| 280 |
|
|
|
| 281 |
|
|
rcsfile(5), C<splitrcs.pl>, C<RCSFormat.pm>
|
| 282 |
|
|
|
| 283 |
|
|
=head1 LICENSE
|
| 284 |
|
|
|
| 285 |
|
|
Copyright 2004 Wakaba <w@suika.fam.cx>. All rights reserved.
|
| 286 |
|
|
|
| 287 |
|
|
This program is free software; you can redistribute it and/or
|
| 288 |
|
|
modify it under the same terms as Perl itself.
|
| 289 |
|
|
|
| 290 |
|
|
=cut
|
| 291 |
|
|
|
| 292 |
|
|
# $Date:$
|
Parent Directory
| 
Revision Log