view release on metacpan or  search on metacpan

lib/App/Gitc/Util.pm  view on Meta::CPAN

        }
        elsif ( $? & 127 ) {
            $msg = sprintf "died with signal %d", ( $? & 127 );
        }
        else {
            $msg = sprintf "exited with value %d", ( $? >> 8 );
        }
        require Carp;
        Carp::croak("git $command_line failed: $msg");
    }
    elsif ( wantarray ) {  # list context
        warn "> git $command_line\n" if $ENV{DEBUG};
        my @output = qx{git $command_line};
        # there's no reliable way to check if this failed
        chomp @output;
        return @output;
    }

    # scalar context
    warn "> git $command_line\n" if $ENV{DEBUG};
    my $output = qx{git $command_line};
    if ( not defined $output ) {
        require Carp;
        Carp::croak("git $command_line failed: $!");
    }

    chdir $start unless $start eq $base;

    chomp $output;
    return $output;
}


sub git_config {
    our %config;

    if ( not keys %config ) {
        for my $line ( git "config -l" ) {
            my ($name, $value) = split /=/, $line;
            my @parts = split /[.]/, $name;
            my $here = \%config;
            for my $part ( @parts[ 0 .. $#parts-1 ] ) {
                $here->{$part} = {} if not $here->{$part};
                $here = $here->{$part};
            }
            $here->{ $parts[-1] } = $value;
        }
    }

    return \%config;
}


sub guarantee_a_clean_working_directory {
    my $arguments = "diff -C -M --name-status";
    my $staged    = git "$arguments --cached";
    my $changed   = git $arguments;
    return if not $staged and not $changed;

    # the tree is dirty, verify whether to continue
    warn "It looks like you have uncommitted changes. If this is expected,\n"
       . "type 'y' to continue.  If it's not expected, type 'n'.\n"
       . ( $staged  ? "staged:\n$staged\n"   : '' )
       . ( $changed ? "changed:\n$changed\n" : '' )
       ;
    die "Aborting at the user's request.\n" if not confirm('Continue?');

    # stash the changes to let them be restored later
    my $stash = git "stash create";
    git "reset --hard";
    return $stash;
}


sub let_user_edit {
    my ($filename) = @_;

    my $editor = $ENV{EDITOR} || $ENV{VISUAL} || '/usr/bin/vim';
    system "$editor $filename";
}

sub create_blob {
    my ($data_ref) = @_;

    my $tmp_file = "meta-$$.tmp";

    open my $tmp, ">", $tmp_file;
    print {$tmp} Dump($data_ref);
    print {$tmp} "\n";

    my $blob = git "hash-object -w $tmp_file";

    close $tmp;
    unlink $tmp_file;

    return $blob;
}

sub view_blob {
    my ($ref) = @_;

    my $output = git "show $ref";
    
    return ($output and $output !~ /^fatal:/) ? Load($output) : undef;
}

sub get_user_name {
    my $git_user = git 'config --get user.name';
    my $git_config = git_config();

    return $git_user || $git_config->{user}{name} || getpwuid $>;    
}

sub get_user_email {
    my ($user) = @_;
    return git 'config --get user.email' unless $user;
    fetch_tags();
    my $git_config = git_config();

    my $user_info = view_blob("user/$user") || {};