mzs: adjust relative paths to match ipreg repo
[ipreg/sccs2rcs2cvs2git.git] / tar2usermap
1 #!/usr/bin/perl
2
3 use warnings;
4 use strict;
5
6 use Data::Dumper;
7
8 sub usage () {
9         die <<USAGE;
10 usage: tar2usermap -m<usermap> [remove/] [insert/]
11
12 tar2usermap reads the output of `tar tfv` and uses it to create or
13 extend a file that maps from file names to owners. The usermap file is
14 output using Perl Data::Dumper.
15
16 USAGE
17 }
18
19 sub shite { die "tar2usermap: @_: $!\n"; }
20 sub shit  { die "tar2usermap: @_\n"; }
21
22 usage unless @ARGV > 0 || @ARGV < 3;
23 usage unless $ARGV[0] =~ m{^-m(.*)};
24 my $f = $1;
25 shift;
26
27 my $insert = '';
28 my $remove = '';
29 $insert = pop if @ARGV;
30 $remove = pop if @ARGV;
31
32 $remove = quotemeta $remove;
33
34 our $usermap;
35 if (-f $f) {
36         do $f or shite "read $f";
37         shit "missing usermap in $f" unless defined $usermap;
38 }
39
40 while (<>) {
41         m{^[-dlh][-r][-w][-sx][-r][-w][-sx][-r][-w][-sx]\s+
42           (?:\d+\s+)?(\S+)(?:\s+|/)\S+\s+\d+\s+
43           (?:[A-Z][a-z][a-z]\s+\d+\s+[12]\d{3}
44             |\d{4}(?:-\d\d){2}\s+\d\d:\d\d)\s+
45           $remove(.*?)(?: link to .*)?$
46           }x
47               or shit "could not parse $_";
48         $usermap->{"$insert$2"} = $1;
49 }
50
51 open my $h, '>', $f
52     or shite "open > $f";
53 print $h Data::Dumper->Dump([$usermap],['usermap']);