1#!/usr/bin/perl
2#
3# Copyright 2005, Ryan Anderson <ryan@michonline.com>
4# Josef Weidendorfer <Josef.Weidendorfer@gmx.de>
5#
6# This file is licensed under the GPL v2, or a later version
7# at the discretion of Linus Torvalds.
8
9use warnings;
10use strict;
11use Getopt::Std;
12use Git;
13
14sub usage() {
15 print <<EOT;
16$0 [-f] [-n] <source> <destination>
17$0 [-f] [-n] [-k] <source> ... <destination directory>
18EOT
19 exit(1);
20}
21
22our ($opt_n, $opt_f, $opt_h, $opt_k, $opt_v);
23getopts("hnfkv") || usage;
24usage() if $opt_h;
25@ARGV >= 1 or usage;
26
27my $repo = Git->repository();
28
29my (@srcArgs, @dstArgs, @srcs, @dsts);
30my ($src, $dst, $base, $dstDir);
31
32# remove any trailing slash in arguments
33for (@ARGV) { s/\/*$//; }
34
35my $argCount = scalar @ARGV;
36if (-d $ARGV[$argCount-1]) {
37 $dstDir = $ARGV[$argCount-1];
38 @srcArgs = @ARGV[0..$argCount-2];
39
40 foreach $src (@srcArgs) {
41 $base = $src;
42 $base =~ s/^.*\///;
43 $dst = "$dstDir/". $base;
44 push @dstArgs, $dst;
45 }
46}
47else {
48 if ($argCount < 2) {
49 print "Error: need at least two arguments\n";
50 exit(1);
51 }
52 if ($argCount > 2) {
53 print "Error: moving to directory '"
54 . $ARGV[$argCount-1]
55 . "' not possible; not existing\n";
56 exit(1);
57 }
58 @srcArgs = ($ARGV[0]);
59 @dstArgs = ($ARGV[1]);
60 $dstDir = "";
61}
62
63my $subdir_prefix = $repo->wc_subdir();
64
65# run in git base directory, so that git-ls-files lists all revisioned files
66chdir $repo->wc_path();
67$repo->wc_chdir('');
68
69# normalize paths, needed to compare against versioned files and update-index
70# also, this is nicer to end-users by doing ".//a/./b/.//./c" ==> "a/b/c"
71for (@srcArgs, @dstArgs) {
72 # prepend git prefix as we run from base directory
73 $_ = $subdir_prefix.$_;
74 s|^\./||;
75 s|/\./|/| while (m|/\./|);
76 s|//+|/|g;
77 # Also "a/b/../c" ==> "a/c"
78 1 while (s,(^|/)[^/]+/\.\./,$1,);
79}
80
81my (@allfiles,@srcfiles,@dstfiles);
82my $safesrc;
83my (%overwritten, %srcForDst);
84
85{
86 local $/ = "\0";
87 @allfiles = $repo->command('ls-files', '-z');
88}
89
90
91my ($i, $bad);
92while(scalar @srcArgs > 0) {
93 $src = shift @srcArgs;
94 $dst = shift @dstArgs;
95 $bad = "";
96
97 for ($src, $dst) {
98 # Be nicer to end-users by doing ".//a/./b/.//./c" ==> "a/b/c"
99 s|^\./||;
100 s|/\./|/| while (m|/\./|);
101 s|//+|/|g;
102 # Also "a/b/../c" ==> "a/c"
103 1 while (s,(^|/)[^/]+/\.\./,$1,);
104 }
105
106 if ($opt_v) {
107 print "Checking rename of '$src' to '$dst'\n";
108 }
109
110 unless (-f $src || -l $src || -d $src) {
111 $bad = "bad source '$src'";
112 }
113
114 $safesrc = quotemeta($src);
115 @srcfiles = grep /^$safesrc(\/|$)/, @allfiles;
116
117 $overwritten{$dst} = 0;
118 if (($bad eq "") && -e $dst) {
119 $bad = "destination '$dst' already exists";
120 if ($opt_f) {
121 # only files can overwrite each other: check both source and destination
122 if (-f $dst && (scalar @srcfiles == 1)) {
123 print "Warning: $bad; will overwrite!\n";
124 $bad = "";
125 $overwritten{$dst} = 1;
126 }
127 else {
128 $bad = "Can not overwrite '$src' with '$dst'";
129 }
130 }
131 }
132
133 if (($bad eq "") && ($dst =~ /^$safesrc\//)) {
134 $bad = "can not move directory '$src' into itself";
135 }
136
137 if ($bad eq "") {
138 if (scalar @srcfiles == 0) {
139 $bad = "'$src' not under version control";
140 }
141 }
142
143 if ($bad eq "") {
144 if (defined $srcForDst{$dst}) {
145 $bad = "can not move '$src' to '$dst'; already target of ";
146 $bad .= "'".$srcForDst{$dst}."'";
147 }
148 else {
149 $srcForDst{$dst} = $src;
150 }
151 }
152
153 if ($bad ne "") {
154 if ($opt_k) {
155 print "Warning: $bad; skipping\n";
156 next;
157 }
158 print "Error: $bad\n";
159 exit(1);
160 }
161 push @srcs, $src;
162 push @dsts, $dst;
163}
164
165# Final pass: rename/move
166my (@deletedfiles,@addedfiles,@changedfiles);
167$bad = "";
168while(scalar @srcs > 0) {
169 $src = shift @srcs;
170 $dst = shift @dsts;
171
172 if ($opt_n || $opt_v) { print "Renaming $src to $dst\n"; }
173 if (!$opt_n) {
174 if (!rename($src,$dst)) {
175 $bad = "renaming '$src' failed: $!";
176 if ($opt_k) {
177 print "Warning: skipped: $bad\n";
178 $bad = "";
179 next;
180 }
181 last;
182 }
183 }
184
185 $safesrc = quotemeta($src);
186 @srcfiles = grep /^$safesrc(\/|$)/, @allfiles;
187 @dstfiles = @srcfiles;
188 s/^$safesrc(\/|$)/$dst$1/ for @dstfiles;
189
190 push @deletedfiles, @srcfiles;
191 if (scalar @srcfiles == 1) {
192 # $dst can be a directory with 1 file inside
193 if ($overwritten{$dst} ==1) {
194 push @changedfiles, $dstfiles[0];
195
196 } else {
197 push @addedfiles, $dstfiles[0];
198 }
199 }
200 else {
201 push @addedfiles, @dstfiles;
202 }
203}
204
205if ($opt_n) {
206 if (@changedfiles) {
207 print "Changed : ". join(", ", @changedfiles) ."\n";
208 }
209 if (@addedfiles) {
210 print "Adding : ". join(", ", @addedfiles) ."\n";
211 }
212 if (@deletedfiles) {
213 print "Deleting : ". join(", ", @deletedfiles) ."\n";
214 }
215}
216else {
217 if (@changedfiles) {
218 my ($fd, $ctx) = $repo->command_input_pipe('update-index', '-z', '--stdin');
219 foreach my $fileName (@changedfiles) {
220 print $fd "$fileName\0";
221 }
222 git_cmd_try { $repo->command_close_pipe($fd, $ctx); }
223 'git-update-index failed to update changed files with code %d';
224 }
225 if (@addedfiles) {
226 my ($fd, $ctx) = $repo->command_input_pipe('update-index', '--add', '-z', '--stdin');
227 foreach my $fileName (@addedfiles) {
228 print $fd "$fileName\0";
229 }
230 git_cmd_try { $repo->command_close_pipe($fd, $ctx); }
231 'git-update-index failed to add new files with code %d';
232 }
233 if (@deletedfiles) {
234 my ($fd, $ctx) = $repo->command_input_pipe('update-index', '--remove', '-z', '--stdin');
235 foreach my $fileName (@deletedfiles) {
236 print $fd "$fileName\0";
237 }
238 git_cmd_try { $repo->command_close_pipe($fd, $ctx); }
239 'git-update-index failed to remove old files with code %d';
240 }
241}
242
243if ($bad ne "") {
244 print "Error: $bad\n";
245 exit(1);
246}