tool/bin/splitrcs.pl

#!/usr/bin/perl 
use lib q#../lib#;
use strict;
our $VERSION=do{my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
require RCSFormat;
require IO::File;

$/ = undef;
my $filename = shift @ARGV;
my $rcs = new RCSFormat;
my $in = new IO::File $filename, 'r' or die "$0: $filename: $!";
binmode $in;
$rcs->parse_text (scalar <$in>);
close $in;

my %outputed;
$filename =~ s/,v$//g;
output_file ($rcs, revision => $rcs->{admin}->{head}, filename_base => $filename);

sub output_file ($%) {
  my ($rcs, %opt) = @_;
  my $date = $rcs->{delta}->{$opt{revision}}->{date};
  $date =~ s/^(\d\d)\./19$1/;
  $date =~ tr/.//d;
  my $filename = $opt{filename_base} . '.' . $date;
  if (-e $filename) {
    my $i = 1;
    $i++ while -e $filename . '.' . $i;
    $filename .= '.' . $i;
  }
  
  STDERR->print ("$0: Writing $opt{revision} as $filename...\n");
  
  my $text;
  if ($opt{previous_text}) {
    $text = patch_rcs_diff ($opt{previous_text}
              => \$rcs->{deltatext}->{$opt{revision}}->{text});
  } else {
    $text = $rcs->{deltatext}->{$opt{revision}}->{text};
  }
  my $file = new IO::File $filename, 'w' or die "$0: $filename: $!";
  binmode $file;
  print $file ($text);
  $file->close;
  
  $outputed{$opt{revision}} = 1;
  output_file ($rcs, %opt, revision => $rcs->{delta}->{$opt{revision}}->{next},
               previous_text => \$text)
    if $rcs->{delta}->{$opt{revision}}->{next} and
       not $outputed{$rcs->{delta}->{$opt{revision}}->{next}};
}

sub patch_rcs_diff ($$) {
  my @src = split /\x0A/, ${+shift}, -1;
  my @patch = split /\x0A/, ${+shift}, -1;
  my @result;
  my $i = 0;
  while (@patch) {
    $_ = shift @patch;
    if (/^a(\d+) (\d+)/) {
      push @result, @src[$i..$1-1], splice @patch, 0, $2;
      $i = $1;
    } elsif (/^d(\d+) (\d+)/) {
      push @result, @src[$i..$1-2];
      $i = $1 - 1 + $2;
    } else {
      warn "$0: Invalid diff: ".$_ unless $_ eq '';
    }
  }
  push @result, @src[$i..$#src];
  join "\x0A", @result;
}

__END__

=head1 NAME

splitrcs - Split RCS file

=head1 SYNOPSIS

  splitrcs.pl rcs,v

=head1 DESCRIPTION

C<splitrcs> splits a RCS format version history file into multiple files.
Each history entry is saved as a single file, with its filename suffixed by
FULL STOP (.) and DIGITs representing last-modified date-time.

=head1 BUGS

=over 4

=item *

This script does not support branches yet.

=item *

C<--help> should display help message.

=back

=head1 SEE ALSO

rcsfile(5), C<knitmodule.pl>, C<RCSFormat.pm>

=head1 LICENSE

Copyright 2004 Wakaba <w@suika.fam.cx>.  All rights reserved.

This program is free software; you can redistribute it and/or 
modify it under the same terms as Perl itself.

=cut

# $Date: 2004/01/25 07:47:53 $
1	wakaba	1.1	#!/usr/bin/perl
2			use lib q#../lib#;
3			use strict;
4	wakaba	1.2	our $VERSION=do{my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
5	wakaba	1.1	require RCSFormat;
6			require IO::File;
7
8			$/ = undef;
9			my $filename = shift @ARGV;
10			my $rcs = new RCSFormat;
11			my $in = new IO::File $filename, 'r' or die "$0: $filename: $!";
12			binmode $in;
13			$rcs->parse_text (scalar <$in>);
14			close $in;
15
16			my %outputed;
17			$filename =~ s/,v$//g;
18			output_file ($rcs, revision => $rcs->{admin}->{head}, filename_base => $filename);
19
20			sub output_file ($%) {
21			my ($rcs, %opt) = @_;
22			my $date = $rcs->{delta}->{$opt{revision}}->{date};
23			$date =~ s/^(\d\d)\./19$1/;
24			$date =~ tr/.//d;
25			my $filename = $opt{filename_base} . '.' . $date;
26			if (-e $filename) {
27			my $i = 1;
28			$i++ while -e $filename . '.' . $i;
29			$filename .= '.' . $i;
30			}
31
32			STDERR->print ("$0: Writing $opt{revision} as $filename...\n");
33
34			my $text;
35			if ($opt{previous_text}) {
36			$text = patch_rcs_diff ($opt{previous_text}
37			=> \$rcs->{deltatext}->{$opt{revision}}->{text});
38			} else {
39			$text = $rcs->{deltatext}->{$opt{revision}}->{text};
40			}
41			my $file = new IO::File $filename, 'w' or die "$0: $filename: $!";
42			binmode $file;
43			print $file ($text);
44			$file->close;
45
46			$outputed{$opt{revision}} = 1;
47			output_file ($rcs, %opt, revision => $rcs->{delta}->{$opt{revision}}->{next},
48			previous_text => \$text)
49			if $rcs->{delta}->{$opt{revision}}->{next} and
50			not $outputed{$rcs->{delta}->{$opt{revision}}->{next}};
51			}
52
53			sub patch_rcs_diff ($$) {
54			my @src = split /\x0A/, ${+shift}, -1;
55			my @patch = split /\x0A/, ${+shift}, -1;
56			my @result;
57			my $i = 0;
58			while (@patch) {
59			$_ = shift @patch;
60			if (/^a(\d+) (\d+)/) {
61			push @result, @src[$i..$1-1], splice @patch, 0, $2;
62			$i = $1;
63			} elsif (/^d(\d+) (\d+)/) {
64			push @result, @src[$i..$1-2];
65			$i = $1 - 1 + $2;
66			} else {
67			warn "$0: Invalid diff: ".$_ unless $_ eq '';
68			}
69			}
70			push @result, @src[$i..$#src];
71			join "\x0A", @result;
72			}
73
74			__END__
75
76			=head1 NAME
77
78			splitrcs - Split RCS file
79
80			=head1 SYNOPSIS
81
82			splitrcs.pl rcs,v
83
84			=head1 DESCRIPTION
85
86			C<splitrcs> splits a RCS format version history file into multiple files.
87			Each history entry is saved as a single file, with its filename suffixed by
88			FULL STOP (.) and DIGITs representing last-modified date-time.
89
90			=head1 BUGS
91
92	wakaba	1.2	=over 4
93	wakaba	1.1
94			=item *
95
96			This script does not support branches yet.
97
98			=item *
99
100			C<--help> should display help message.
101
102	wakaba	1.2	=back
103
104	wakaba	1.1	=head1 SEE ALSO
105
106			rcsfile(5), C<knitmodule.pl>, C<RCSFormat.pm>
107
108			=head1 LICENSE
109
110			Copyright 2004 Wakaba <w@suika.fam.cx>. All rights reserved.
111
112			This program is free software; you can redistribute it and/or
113			modify it under the same terms as Perl itself.
114
115			=cut
116
117	wakaba	1.2	# $Date: 2004/01/25 07:47:53 $