Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #!/usr/bin/env perl
- # Copyright (C) 2006, Shawn Pearce <spearce@spearce.org>
- # This file is licensed under the GPL v2, or a later version
- # at the discretion of Linus.
- package Git;
- sub remote_refs {
- my ($self, $repo, $groups, $refglobs) = _maybe_self(@_);
- my @args;
- if (ref $groups eq 'ARRAY') {
- foreach (@$groups) {
- if ($_ eq 'heads') {
- push (@args, '--heads');
- } elsif ($_ eq 'tags') {
- push (@args, '--tags');
- } else {
- # Ignore unknown groups for future
- # compatibility
- }
- }
- }
- push (@args, $repo);
- if (ref $refglobs eq 'ARRAY') {
- push (@args, @$refglobs);
- }
- my @self = $self ? ($self) : (); # Ultra trickery
- my ($fh, $ctx) = Git::command_output_pipe(@self, 'ls-remote', @args);
- my %refs;
- while (<$fh>) {
- chomp;
- my ($hash, $ref) = split(/\t/, $_, 2);
- $refs{$ref} = $hash;
- }
- Git::command_close_pipe(@self, $fh, $ctx);
- return \%refs;
- }
- use warnings;
- use strict;
- use Git;
- my $remote = shift || 'origin';
- my $repo = Git->repository();
- # Build our list of refs.
- #
- my $remote_refs = ls_refs($repo, $remote);
- my $local_refs = ls_refs($repo, $repo->repo_path());
- my $remote_HEAD = $remote_refs->{'HEAD'};
- my $local_HEAD = $local_refs->{'HEAD'};
- delete $remote_refs->{'HEAD'};
- delete $local_refs->{'HEAD'};
- # Execute the fetch for any refs which differ from our own.
- # We don't worry about trying to optimize for rewinds or
- # exact branch copies as they are rather uncommon.
- #
- my @to_fetch;
- while (my ($ref, $hash) = each %$remote_refs) {
- push(@to_fetch, "$ref:$ref")
- if (!$local_refs->{$ref} || $local_refs->{$ref} ne $hash);
- }
- if (@to_fetch) {
- git_cmd_try {
- $repo->command_noisy('fetch',
- '--force',
- '--update-head-ok',
- $remote, sort @to_fetch);
- } '%s failed w/ code %d';
- } else {
- print "No changed refs. Skipping fetch.\n";
- }
- # See what the remote has HEAD pointing at and update our local
- # HEAD to point at some ref which points at the same hash.
- # Prefer to keep HEAD the same if possible to avoid HEAD drifting
- # between different branches.
- # Note that with dumb protocols, we don't get to *know* HEAD implicitly
- # with git-ls-remote...
- #
- git_cmd_try {
- my $headref = $repo->command_oneline('symbolic-ref', 'HEAD');
- my $HEAD;
- if (not $remote_refs->{$headref}) {
- $HEAD = 'refs/heads/master';
- print "Local HEAD branch disappeared, falling back to refs/heads/master\n";
- } elsif ($remote_HEAD and $remote_refs->{$headref} ne $remote_HEAD) {
- my %by_hash = map {$remote_refs->{$_} => $_}
- grep {m,^refs/heads/,}
- sort keys %$remote_refs;
- $HEAD = $by_hash{$remote_HEAD};
- if ($HEAD) {
- print "Setting HEAD to $HEAD ($remote_HEAD)\n";
- } else {
- print "Remote HEAD ($remote_HEAD) does not match any remote branch\n";
- }
- }
- if ($HEAD) {
- $repo->command_noisy('symbolic-ref', 'HEAD', $HEAD);
- }
- } '%s failed w/ code %d';
- # Delete any local refs which the server no longer contains.
- #
- foreach my $ref (keys %$local_refs) {
- next if $remote_refs->{$ref};
- print "Removing $ref\n";
- git_cmd_try {
- $repo->command_noisy('update-ref', '-d', $ref, $local_refs->{$ref});
- } '%s failed w/ code %d';
- }
- sub ls_refs {
- my $repo = shift;
- my $name = shift;
- my $refs = $repo->remote_refs($name);
- my @interesting = grep {
- $_ eq 'HEAD' or (/^refs\// and not /\.\./ and not /\^{}$/);
- } keys %$refs;
- my %refs2;
- # This funky-looking expression puts @interesting-subset of %$refs
- # to %refs2.
- @refs2{@interesting} = @{$refs}{@interesting};
- \%refs2;
- }
Add Comment
Please, Sign In to add comment