git-p4: chdir now properly sets PWD environment variable in msysGit
[git/git-p4.git] / git-relink.perl
blob937c69a74858a8a3c63bb41a23705b579df1b3a3
1 #!/usr/bin/env perl
2 # Copyright 2005, Ryan Anderson <ryan@michonline.com>
3 # Distribution permitted under the GPL v2, as distributed
4 # by the Free Software Foundation.
5 # Later versions of the GPL at the discretion of Linus Torvalds
7 # Scan two git object-trees, and hardlink any common objects between them.
9 use 5.006;
10 use strict;
11 use warnings;
12 use Getopt::Long;
14 sub get_canonical_form($);
15 sub do_scan_directory($$$);
16 sub compare_two_files($$);
17 sub usage();
18 sub link_two_files($$);
20 # stats
21 my $total_linked = 0;
22 my $total_already = 0;
23 my ($linked,$already);
25 my $fail_on_different_sizes = 0;
26 my $help = 0;
27 GetOptions("safe" => \$fail_on_different_sizes,
28 "help" => \$help);
30 usage() if $help;
32 my (@dirs) = @ARGV;
34 usage() if (!defined $dirs[0] || !defined $dirs[1]);
36 $_ = get_canonical_form($_) foreach (@dirs);
38 my $master_dir = pop @dirs;
40 opendir(D,$master_dir . "objects/")
41 or die "Failed to open $master_dir/objects/ : $!";
43 my @hashdirs = grep { ($_ eq 'pack') || /^[0-9a-f]{2}$/ } readdir(D);
45 foreach my $repo (@dirs) {
46 $linked = 0;
47 $already = 0;
48 printf("Searching '%s' and '%s' for common objects and hardlinking them...\n",
49 $master_dir,$repo);
51 foreach my $hashdir (@hashdirs) {
52 do_scan_directory($master_dir, $hashdir, $repo);
55 printf("Linked %d files, %d were already linked.\n",$linked, $already);
57 $total_linked += $linked;
58 $total_already += $already;
61 printf("Totals: Linked %d files, %d were already linked.\n",
62 $total_linked, $total_already);
65 sub do_scan_directory($$$) {
66 my ($srcdir, $subdir, $dstdir) = @_;
68 my $sfulldir = sprintf("%sobjects/%s/",$srcdir,$subdir);
69 my $dfulldir = sprintf("%sobjects/%s/",$dstdir,$subdir);
71 opendir(S,$sfulldir)
72 or die "Failed to opendir $sfulldir: $!";
74 foreach my $file (grep(!/\.{1,2}$/, readdir(S))) {
75 my $sfilename = $sfulldir . $file;
76 my $dfilename = $dfulldir . $file;
78 compare_two_files($sfilename,$dfilename);
81 closedir(S);
84 sub compare_two_files($$) {
85 my ($sfilename, $dfilename) = @_;
87 # Perl's stat returns relevant information as follows:
88 # 0 = dev number
89 # 1 = inode number
90 # 7 = size
91 my @sstatinfo = stat($sfilename);
92 my @dstatinfo = stat($dfilename);
94 if (@sstatinfo == 0 && @dstatinfo == 0) {
95 die sprintf("Stat of both %s and %s failed: %s\n",$sfilename, $dfilename, $!);
97 } elsif (@dstatinfo == 0) {
98 return;
101 if ( ($sstatinfo[0] == $dstatinfo[0]) &&
102 ($sstatinfo[1] != $dstatinfo[1])) {
103 if ($sstatinfo[7] == $dstatinfo[7]) {
104 link_two_files($sfilename, $dfilename);
106 } else {
107 my $err = sprintf("ERROR: File sizes are not the same, cannot relink %s to %s.\n",
108 $sfilename, $dfilename);
109 if ($fail_on_different_sizes) {
110 die $err;
111 } else {
112 warn $err;
116 } elsif ( ($sstatinfo[0] == $dstatinfo[0]) &&
117 ($sstatinfo[1] == $dstatinfo[1])) {
118 $already++;
122 sub get_canonical_form($) {
123 my $dir = shift;
124 my $original = $dir;
126 die "$dir is not a directory." unless -d $dir;
128 $dir .= "/" unless $dir =~ m#/$#;
129 $dir .= ".git/" unless $dir =~ m#\.git/$#;
131 die "$original does not have a .git/ subdirectory.\n" unless -d $dir;
133 return $dir;
136 sub link_two_files($$) {
137 my ($sfilename, $dfilename) = @_;
138 my $tmpdname = sprintf("%s.old",$dfilename);
139 rename($dfilename,$tmpdname)
140 or die sprintf("Failure renaming %s to %s: %s",
141 $dfilename, $tmpdname, $!);
143 if (! link($sfilename,$dfilename)) {
144 my $failtxt = "";
145 unless (rename($tmpdname,$dfilename)) {
146 $failtxt = sprintf(
147 "Git Repository containing %s is probably corrupted, " .
148 "please copy '%s' to '%s' to fix.\n",
149 $tmpdname, $dfilename);
152 die sprintf("Failed to link %s to %s: %s\n%s" .
153 $sfilename, $dfilename,
154 $!, $dfilename, $failtxt);
157 unlink($tmpdname)
158 or die sprintf("Unlink of %s failed: %s\n",
159 $dfilename, $!);
161 $linked++;
165 sub usage() {
166 print("Usage: git relink [--safe] <dir> [<dir> ...] <master_dir> \n");
167 print("All directories should contain a .git/objects/ subdirectory.\n");
168 print("Options\n");
169 print("\t--safe\t" .
170 "Stops if two objects with the same hash exist but " .
171 "have different sizes. Default is to warn and continue.\n");
172 exit(1);