| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202 |
- #!/usr/bin/perl
- # vim: sts=4 sw=4 ts=4 expandtab:
- # gl - List files from .git/gitids.txt
- use strict;
- use warnings;
- use File::Spec;
- use Cwd qw/getcwd abs_path/;
- =pod
- =head1 NAME
- git-list
- =head1 SYNOPSIS
- git-list [-h] [number pattern]
- =head1 DESCRIPTION
- git-list lists the corresponding filenames given their numbers that was
- previously assigned by git-id. It lists one filename per line of output. Any
- other argument or numbers that has no filenames associated with it will be
- printed as is.
- [number pattern] can either be a single number or a range:
- git-list 1 5-6
- =head1 OPTIONS
- -h Show this help message
- =head1 SEE ALSO
- git-number(1), git-id(1)
- =cut
- if (defined $ARGV[0] && $ARGV[0] eq '-h') {
- system(qq[perldoc $0]);
- exit 0;
- }
- my $wanted_ids = explode_args(@ARGV);
- if (ref $wanted_ids eq 'ARRAY') {
- my $file_for = get_file_ids();
- foreach my $id (@$wanted_ids) {
- if (defined $file_for->{$id}) {
- print $file_for->{$id};
- } else {
- print $id;
- }
- print "\n";
- }
- } elsif ($wanted_ids eq 'all') {
- my @file_list = get_file_list();
- foreach my $entry (@file_list) {
- print $entry->{filename} . "\n";
- }
- }
- exit 0;
- # Add subs below this line
- sub get_file_list {
- my $git_dir = `git rev-parse --git-dir`;
- chomp $git_dir;
- my $gitids = "$git_dir/gitids.txt";
- if (! -f $gitids) {
- print "Please run git-number first\n";
- exit 1;
- }
- open my $cache, "<$gitids" or die "Error: $!";
- my $headers = read_headers($cache);
- my $cwd = getcwd();
- my $needfixdir = 0;
- if ($headers->{cwd} ne $cwd) {
- $needfixdir = 1;
- $cwd = abs_path($cwd);
- }
- my @file_list;
- my $status_processor_for = {
- '' => sub {
- while (my $line = <$cache>) {
- next if $line !~ /^#?[0-9]+\t/;
- chomp $line;
- if (my ($number, $status, $filename)
- = $line =~ /^#?([0-9]+)\t([^:]+:\s+)?(.*)/) {
- if ($filename =~ / \(.*\)$/ && ! -e $filename) {
- # Looks like a submodule status, see if it really is a submodule
- my ($dir) = $filename =~ /(.*) \(.*\)$/;
- if (-d $dir && -e "$dir/.git") {
- $filename = $dir;
- }
- }
- if ($needfixdir) {
- $filename = fixdir($filename, $headers->{cwd}, $cwd);
- }
- push @file_list, {
- number => $number,
- status => $status,
- filename => $filename,
- };
- }
- }
- },
- '--short' => sub {
- while (my $line = <$cache>) {
- next if $line !~ /^[0-9]+\s/;
- chomp $line;
- if (my ($number, $status, $filename)
- = $line =~ /^([0-9]+)\s+([^ ]+)\s+(.*)/) {
- if ($needfixdir) {
- $filename = fixdir($filename, $headers->{cwd}, $cwd);
- }
- push @file_list, {
- number => $number,
- status => $status,
- filename => $filename,
- };
- }
- }
- },
- };
- my $status_format = $headers->{'status-format'};
- $status_processor_for->{$status_format}->();
- close $cache;
- return @file_list;
- }
- sub read_headers {
- my ($cache) = @_;
- my %headers;
- while (my $line = <$cache>) {
- chomp $line;
- last if length $line == 0;
- my ($field, $value) = split(/:\s*/, $line, 2);
- $headers{$field} = $value;
- }
- return \%headers;
- }
- sub get_file_ids {
- my @file_list = get_file_list();
- my %file_for;
- foreach my $entry (@file_list) {
- my $filename = $entry->{filename};
- # First we escape characters that need escaping
- if ($filename =~ /[`\$"]/) {
- $filename =~ s/([`\$"])/\\$1/g;
- }
- # Then we double-quote the name if necessary
- if ($filename =~ /[ '\[\]()&]/) {
- $filename = '"' . $filename . '"';
- }
- $file_for{$entry->{number}} = $filename;
- }
- return \%file_for;
- }
- sub explode_args {
- my (@ARGV) = @_;
- if (scalar @ARGV == 0) {
- return 'all';
- }
- my @wanted_ids;
- foreach my $arg (@ARGV) {
- if ($arg =~ m/^[0-9]+$/) {
- push @wanted_ids, $arg;
- } elsif ($arg =~ m/^([0-9]+)-([0-9]+)/) {
- my $a = $1;
- my $b = $2;
- if ($a > $b) {
- $a = $b;
- $b = $1;
- }
- push @wanted_ids, $a..$b;
- } else {
- push @wanted_ids, $arg;
- }
- }
- return \@wanted_ids;
- }
- sub fixdir {
- my ($filename, $orig_cwd, $cwd) = @_;
- my $abspath = File::Spec->catfile($orig_cwd, $filename);
- $abspath = abs_path($abspath);
- return File::Spec->abs2rel($abspath, $cwd);
- }
|