| 1 |
#!/usr/bin/perl
|
| 2 |
use lib q#../lib#;
|
| 3 |
use strict;
|
| 4 |
our $VERSION=do{my @r=(q$Revision: 1.1 $=~/\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 |
=back
|
| 280 |
|
| 281 |
=head1 SEE ALSO
|
| 282 |
|
| 283 |
rcsfile(5), C<splitrcs.pl>, C<RCSFormat.pm>
|
| 284 |
|
| 285 |
=head1 LICENSE
|
| 286 |
|
| 287 |
Copyright 2004 Wakaba <w@suika.fam.cx>. All rights reserved.
|
| 288 |
|
| 289 |
This program is free software; you can redistribute it and/or
|
| 290 |
modify it under the same terms as Perl itself.
|
| 291 |
|
| 292 |
=cut
|
| 293 |
|
| 294 |
# $Date: 2004/01/25 07:47:53 $
|
Parent Directory
| 
Revision Log