diff options
Diffstat (limited to 'perl')
| -rw-r--r-- | perl/Git.pm | 26 | ||||
| -rw-r--r-- | perl/Git/IndexInfo.pm | 6 | ||||
| -rw-r--r-- | perl/Git/SVN.pm | 83 | ||||
| -rw-r--r-- | perl/Git/SVN/Editor.pm | 8 | ||||
| -rw-r--r-- | perl/Git/SVN/Fetcher.pm | 6 | ||||
| -rw-r--r-- | perl/Git/SVN/Log.pm | 2 | ||||
| -rw-r--r-- | perl/Git/SVN/Ra.pm | 4 |
7 files changed, 83 insertions, 52 deletions
diff --git a/perl/Git.pm b/perl/Git.pm index 54c9ed0dde..10df990959 100644 --- a/perl/Git.pm +++ b/perl/Git.pm @@ -723,6 +723,32 @@ sub config_int { return scalar _config_common({'kind' => '--int'}, @_); } +=item config_regexp ( RE ) + +Retrieve the list of configuration key names matching the regular +expression C<RE>. The return value is a list of strings matching +this regex. + +=cut + +sub config_regexp { + my ($self, $regex) = _maybe_self(@_); + try { + my @cmd = ('config', '--name-only', '--get-regexp', $regex); + unshift @cmd, $self if $self; + my @matches = command(@cmd); + return @matches; + } catch Git::Error::Command with { + my $E = shift; + if ($E->value() == 1) { + my @matches = (); + return @matches; + } else { + throw $E; + } + }; +} + # Common subroutine to implement bulk of what the config* family of methods # do. This currently wraps command('config') so it is not so fast. sub _config_common { diff --git a/perl/Git/IndexInfo.pm b/perl/Git/IndexInfo.pm index a43108c985..2a7b4908f3 100644 --- a/perl/Git/IndexInfo.pm +++ b/perl/Git/IndexInfo.pm @@ -5,13 +5,15 @@ use Git qw/command_input_pipe command_close_pipe/; sub new { my ($class) = @_; + my $hash_algo = Git::config('extensions.objectformat') || 'sha1'; my ($gui, $ctx) = command_input_pipe(qw/update-index -z --index-info/); - bless { gui => $gui, ctx => $ctx, nr => 0}, $class; + bless { gui => $gui, ctx => $ctx, nr => 0, hash_algo => $hash_algo}, $class; } sub remove { my ($self, $path) = @_; - if (print { $self->{gui} } '0 ', 0 x 40, "\t", $path, "\0") { + my $length = $self->{hash_algo} eq 'sha256' ? 64 : 40; + if (print { $self->{gui} } '0 ', 0 x $length, "\t", $path, "\0") { return ++$self->{nr}; } undef; diff --git a/perl/Git/SVN.pm b/perl/Git/SVN.pm index 4b28b87784..d1c352f92b 100644 --- a/perl/Git/SVN.pm +++ b/perl/Git/SVN.pm @@ -2,7 +2,7 @@ package Git::SVN; use strict; use warnings; use Fcntl qw/:DEFAULT :seek/; -use constant rev_map_fmt => 'NH40'; +use constant rev_map_fmt => 'NH*'; use vars qw/$_no_metadata $_repack $_repack_flags $_use_svm_props $_head $_use_svnsync_props $no_reuse_existing @@ -874,7 +874,7 @@ sub assert_index_clean { command_noisy('read-tree', $treeish) unless -e $self->{index}; my $x = command_oneline('write-tree'); my ($y) = (command(qw/cat-file commit/, $treeish) =~ - /^tree ($::sha1)/mo); + /^tree ($::oid)/mo); return if $y eq $x; warn "Index mismatch: $y != $x\nrereading $treeish\n"; @@ -1020,7 +1020,7 @@ sub do_git_commit { $tree = $self->tmp_index_do(sub { command_oneline('write-tree') }); } - die "Tree is not a valid sha1: $tree\n" if $tree !~ /^$::sha1$/o; + die "Tree is not a valid oid $tree\n" if $tree !~ /^$::oid$/o; my @exec = ('git', 'commit-tree', $tree); foreach ($self->get_commit_parents($log_entry)) { @@ -1048,8 +1048,8 @@ sub do_git_commit { close $out_fh or croak $!; waitpid $pid, 0; croak $? if $?; - if ($commit !~ /^$::sha1$/o) { - die "Failed to commit, invalid sha1: $commit\n"; + if ($commit !~ /^$::oid$/o) { + die "Failed to commit, invalid oid: $commit\n"; } $self->rev_map_set($log_entry->{revision}, $commit, 1); @@ -2087,10 +2087,10 @@ sub rebuild_from_rev_db { open my $fh, '<', $path or croak "open: $!"; binmode $fh or croak "binmode: $!"; while (<$fh>) { - length($_) == 41 or croak "inconsistent size in ($_) != 41"; + length($_) == $::oid_length + 1 or croak "inconsistent size in ($_)"; chomp($_); ++$r; - next if $_ eq ('0' x 40); + next if $_ eq ('0' x $::oid_length); $self->rev_map_set($r, $_); print "r$r = $_\n"; } @@ -2150,7 +2150,7 @@ sub rebuild { my $svn_uuid = $self->rewrite_uuid || $self->ra_uuid; my $c; while (<$log>) { - if ( m{^commit ($::sha1)$} ) { + if ( m{^commit ($::oid)$} ) { $c = $1; next; } @@ -2196,9 +2196,9 @@ sub rebuild { # (mainly tags) # # The format is this: -# - 24 bytes for every record, +# - 24 or 36 bytes for every record, # * 4 bytes for the integer representing an SVN revision number -# * 20 bytes representing the sha1 of a git commit +# * 20 or 32 bytes representing the oid of a git commit # - No empty padding records like the old format # (except the last record, which can be overwritten) # - new records are written append-only since SVN revision numbers @@ -2207,7 +2207,7 @@ sub rebuild { # - Piping the file to xxd -c24 is a good way of dumping it for # viewing or editing (piped back through xxd -r), should the need # ever arise. -# - The last record can be padding revision with an all-zero sha1 +# - The last record can be padding revision with an all-zero oid # This is used to optimize fetch performance when using multiple # "fetch" directives in .git/config # @@ -2215,38 +2215,39 @@ sub rebuild { sub _rev_map_set { my ($fh, $rev, $commit) = @_; + my $record_size = ($::oid_length / 2) + 4; binmode $fh or croak "binmode: $!"; my $size = (stat($fh))[7]; - ($size % 24) == 0 or croak "inconsistent size: $size"; + ($size % $record_size) == 0 or croak "inconsistent size: $size"; my $wr_offset = 0; if ($size > 0) { - sysseek($fh, -24, SEEK_END) or croak "seek: $!"; - my $read = sysread($fh, my $buf, 24) or croak "read: $!"; - $read == 24 or croak "read only $read bytes (!= 24)"; + sysseek($fh, -$record_size, SEEK_END) or croak "seek: $!"; + my $read = sysread($fh, my $buf, $record_size) or croak "read: $!"; + $read == $record_size or croak "read only $read bytes (!= $record_size)"; my ($last_rev, $last_commit) = unpack(rev_map_fmt, $buf); - if ($last_commit eq ('0' x40)) { - if ($size >= 48) { - sysseek($fh, -48, SEEK_END) or croak "seek: $!"; - $read = sysread($fh, $buf, 24) or + if ($last_commit eq ('0' x $::oid_length)) { + if ($size >= ($record_size * 2)) { + sysseek($fh, -($record_size * 2), SEEK_END) or croak "seek: $!"; + $read = sysread($fh, $buf, $record_size) or croak "read: $!"; - $read == 24 or - croak "read only $read bytes (!= 24)"; + $read == $record_size or + croak "read only $read bytes (!= $record_size)"; ($last_rev, $last_commit) = unpack(rev_map_fmt, $buf); - if ($last_commit eq ('0' x40)) { + if ($last_commit eq ('0' x $::oid_length)) { croak "inconsistent .rev_map\n"; } } if ($last_rev >= $rev) { croak "last_rev is higher!: $last_rev >= $rev"; } - $wr_offset = -24; + $wr_offset = -$record_size; } } sysseek($fh, $wr_offset, SEEK_END) or croak "seek: $!"; - syswrite($fh, pack(rev_map_fmt, $rev, $commit), 24) == 24 or + syswrite($fh, pack(rev_map_fmt, $rev, $commit), $record_size) == $record_size or croak "write: $!"; } @@ -2271,7 +2272,7 @@ sub mkfile { sub rev_map_set { my ($self, $rev, $commit, $update_ref, $uuid) = @_; defined $commit or die "missing arg3\n"; - length $commit == 40 or die "arg3 must be a full SHA1 hexsum\n"; + $commit =~ /^$::oid$/ or die "arg3 must be a full hex object ID\n"; my $db = $self->map_path($uuid); my $db_lock = "$db.lock"; my $sigmask; @@ -2344,29 +2345,30 @@ sub rev_map_max { sub rev_map_max_norebuild { my ($self, $want_commit) = @_; + my $record_size = ($::oid_length / 2) + 4; my $map_path = $self->map_path; stat $map_path or return $want_commit ? (0, undef) : 0; sysopen(my $fh, $map_path, O_RDONLY) or croak "open: $!"; binmode $fh or croak "binmode: $!"; my $size = (stat($fh))[7]; - ($size % 24) == 0 or croak "inconsistent size: $size"; + ($size % $record_size) == 0 or croak "inconsistent size: $size"; if ($size == 0) { close $fh or croak "close: $!"; return $want_commit ? (0, undef) : 0; } - sysseek($fh, -24, SEEK_END) or croak "seek: $!"; - sysread($fh, my $buf, 24) == 24 or croak "read: $!"; + sysseek($fh, -$record_size, SEEK_END) or croak "seek: $!"; + sysread($fh, my $buf, $record_size) == $record_size or croak "read: $!"; my ($r, $c) = unpack(rev_map_fmt, $buf); - if ($want_commit && $c eq ('0' x40)) { - if ($size < 48) { + if ($want_commit && $c eq ('0' x $::oid_length)) { + if ($size < $record_size * 2) { return $want_commit ? (0, undef) : 0; } - sysseek($fh, -48, SEEK_END) or croak "seek: $!"; - sysread($fh, $buf, 24) == 24 or croak "read: $!"; + sysseek($fh, -($record_size * 2), SEEK_END) or croak "seek: $!"; + sysread($fh, $buf, $record_size) == $record_size or croak "read: $!"; ($r, $c) = unpack(rev_map_fmt, $buf); - if ($c eq ('0'x40)) { + if ($c eq ('0' x $::oid_length)) { croak "Penultimate record is all-zeroes in $map_path"; } } @@ -2387,30 +2389,31 @@ sub rev_map_get { sub _rev_map_get { my ($fh, $rev) = @_; + my $record_size = ($::oid_length / 2) + 4; binmode $fh or croak "binmode: $!"; my $size = (stat($fh))[7]; - ($size % 24) == 0 or croak "inconsistent size: $size"; + ($size % $record_size) == 0 or croak "inconsistent size: $size"; if ($size == 0) { return undef; } - my ($l, $u) = (0, $size - 24); + my ($l, $u) = (0, $size - $record_size); my ($r, $c, $buf); while ($l <= $u) { - my $i = int(($l/24 + $u/24) / 2) * 24; + my $i = int(($l/$record_size + $u/$record_size) / 2) * $record_size; sysseek($fh, $i, SEEK_SET) or croak "seek: $!"; - sysread($fh, my $buf, 24) == 24 or croak "read: $!"; + sysread($fh, my $buf, $record_size) == $record_size or croak "read: $!"; my ($r, $c) = unpack(rev_map_fmt, $buf); if ($r < $rev) { - $l = $i + 24; + $l = $i + $record_size; } elsif ($r > $rev) { - $u = $i - 24; + $u = $i - $record_size; } else { # $r == $rev - return $c eq ('0' x 40) ? undef : $c; + return $c eq ('0' x $::oid_length) ? undef : $c; } } undef; diff --git a/perl/Git/SVN/Editor.pm b/perl/Git/SVN/Editor.pm index 0df16ed726..c961444d4c 100644 --- a/perl/Git/SVN/Editor.pm +++ b/perl/Git/SVN/Editor.pm @@ -63,7 +63,7 @@ sub generate_diff { my @mods; while (defined($_ = get_record($diff_fh, "\0"))) { if ($state eq 'meta' && /^:(\d{6})\s(\d{6})\s - ($::sha1)\s($::sha1)\s + ($::oid)\s($::oid)\s ([MTCRAD])\d*$/xo) { push @mods, { mode_a => $1, mode_b => $2, sha1_a => $3, sha1_b => $4, @@ -400,12 +400,12 @@ sub T { ($m->{mode_b} !~ /^120/ && $m->{mode_a} =~ /^120/)) { $self->D({ mode_a => $m->{mode_a}, mode_b => '000000', - sha1_a => $m->{sha1_a}, sha1_b => '0' x 40, + sha1_a => $m->{sha1_a}, sha1_b => '0' x $::oid_length, chg => 'D', file_b => $m->{file_b} }, $deletions); $self->A({ mode_a => '000000', mode_b => $m->{mode_b}, - sha1_a => '0' x 40, sha1_b => $m->{sha1_b}, + sha1_a => '0' x $::oid_length, sha1_b => $m->{sha1_b}, chg => 'A', file_b => $m->{file_b} }, $deletions); return; @@ -434,7 +434,7 @@ sub _chg_file_get_blob ($$$$) { $self->change_file_prop($fbat,'svn:special',undef); } my $blob = $m->{"sha1_$which"}; - return ($fh,) if ($blob =~ /^0{40}$/); + return ($fh,) if ($blob =~ /^0+$/); my $size = $::_repository->cat_blob($blob, $fh); croak "Failed to read object $blob" if ($size < 0); $fh->flush == 0 or croak $!; diff --git a/perl/Git/SVN/Fetcher.pm b/perl/Git/SVN/Fetcher.pm index 64e900a0e9..729e5337df 100644 --- a/perl/Git/SVN/Fetcher.pm +++ b/perl/Git/SVN/Fetcher.pm @@ -173,7 +173,7 @@ sub delete_entry { # remove entire directories. my ($tree) = (command('ls-tree', '-z', $self->{c}, "./$gpath") - =~ /\A040000 tree ([a-f\d]{40})\t\Q$gpath\E\0/); + =~ /\A040000 tree ($::oid)\t\Q$gpath\E\0/); if ($tree) { my ($ls, $ctx) = command_output_pipe(qw/ls-tree -r --name-only -z/, @@ -203,7 +203,7 @@ sub open_file { my $gpath = $self->git_path($path); ($mode, $blob) = (command('ls-tree', '-z', $self->{c}, "./$gpath") - =~ /\A(\d{6}) blob ([a-f\d]{40})\t\Q$gpath\E\0/); + =~ /\A(\d{6}) blob ($::oid)\t\Q$gpath\E\0/); unless (defined $mode && defined $blob) { die "$path was not found in commit $self->{c} (r$rev)\n"; } @@ -413,7 +413,7 @@ sub close_file { $hash = $::_repository->hash_and_insert_object( Git::temp_path($fh)); - $hash =~ /^[a-f\d]{40}$/ or die "not a sha1: $hash\n"; + $hash =~ /^$::oid$/ or die "not an object ID: $hash\n"; Git::temp_release($fb->{base}, 1); Git::temp_release($fh, 1); diff --git a/perl/Git/SVN/Log.pm b/perl/Git/SVN/Log.pm index 664105357c..3858fcf27d 100644 --- a/perl/Git/SVN/Log.pm +++ b/perl/Git/SVN/Log.pm @@ -285,7 +285,7 @@ sub cmd_show_log { my (@k, $c, $d, $stat); my $esc_color = qr/(?:\033\[(?:(?:\d+;)*\d*)?m)*/; while (<$log>) { - if (/^${esc_color}commit (?:- )?($::sha1_short)/o) { + if (/^${esc_color}commit (?:- )?($::oid_short)/o) { my $cmt = $1; if ($c && cmt_showable($c) && $c->{r} != $r_last) { $r_last = $c->{r}; diff --git a/perl/Git/SVN/Ra.pm b/perl/Git/SVN/Ra.pm index 56ad9870bc..2cfe055a9a 100644 --- a/perl/Git/SVN/Ra.pm +++ b/perl/Git/SVN/Ra.pm @@ -486,11 +486,11 @@ sub gs_fetch_loop_common { $reload_ra->() if $ra_invalid; } # pre-fill the .rev_db since it'll eventually get filled in - # with '0' x40 if something new gets committed + # with '0' x $oid_length if something new gets committed foreach my $gs (@$gsv) { next if $gs->rev_map_max >= $max; next if defined $gs->rev_map_get($max); - $gs->rev_map_set($max, 0 x40); + $gs->rev_map_set($max, 0 x $::oid_length); } foreach my $g (@$globs) { my $k = "svn-remote.$g->{remote}.$g->{t}-maxRev"; |