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