File: fix_links.pl

package info (click to toggle)
libpkgconfig-perl 0.26026-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 2,912 kB
  • sloc: ansic: 6,120; perl: 1,922; makefile: 4; sh: 3
file content (38 lines) | stat: -rw-r--r-- 927 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
use strict;
use warnings;
use File::Spec;

# this script requires administrator privileges

warn "this script requires admin privileges, which you don't appear to have"
  unless eval { require Win32; Win32::IsAdminUser() };

my @list = map { chomp; [split /\t/]->[1] } grep /^120000/, `git ls-files -s `;

foreach my $link (@list)
{
  # in case we ran this before
  system "git checkout $link";

  my $target = do { open my $fh, '<', $link; local $/; <$fh> };
  unlink $link;

  my $cmd = "mklink " . File::Spec->catfile($link) . " " . File::Spec->catfile($target);
  print "> $cmd\n";
  system $cmd;

  if($?)
  {
    warn "failed";
    # revert on failure
    system "git checkout $link";
    next;
  }

  # ignore change so that it won't be committed back
  print "> git update-index --assume-unchanged $link\n";
  system 'git', 'update-index', '--assume-unchanged', $link;
}

print "press <ENTER> to continue.\n";
<STDIN>;