Eliminate Scalar::Util usage from private-Error.pm
[git] / git-mv.perl
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
9 use warnings;
10 use strict;
11 use Getopt::Std;
12 use Git;
13
14 sub usage() {
15         print <<EOT;
16 $0 [-f] [-n] <source> <destination>
17 $0 [-f] [-n] [-k] <source> ... <destination directory>
18 EOT
19         exit(1);
20 }
21
22 our ($opt_n, $opt_f, $opt_h, $opt_k, $opt_v);
23 getopts("hnfkv") || usage;
24 usage() if $opt_h;
25 @ARGV >= 1 or usage;
26
27 my $repo = Git->repository();
28
29 my (@srcArgs, @dstArgs, @srcs, @dsts);
30 my ($src, $dst, $base, $dstDir);
31
32 # remove any trailing slash in arguments
33 for (@ARGV) { s/\/*$//; }
34
35 my $argCount = scalar @ARGV;
36 if (-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 }
47 else {
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
63 my $subdir_prefix = $repo->wc_subdir();
64
65 # run in git base directory, so that git-ls-files lists all revisioned files
66 chdir $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"
71 for (@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
81 my (@allfiles,@srcfiles,@dstfiles);
82 my $safesrc;
83 my (%overwritten, %srcForDst);
84
85 {
86         local $/ = "\0";
87         @allfiles = $repo->command('ls-files', '-z');
88 }
89
90
91 my ($i, $bad);
92 while(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
166 my (@deletedfiles,@addedfiles,@changedfiles);
167 $bad = "";
168 while(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
205 if ($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 }
216 else {
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
243 if ($bad ne "") {
244     print "Error: $bad\n";
245     exit(1);
246 }