Merge branch 'ab/git-svn-get-record-typofix'
[git/git.git] / perl / Git.pm
index d453e4b..d856930 100644 (file)
@@ -9,7 +9,10 @@ package Git;
 
 use 5.008;
 use strict;
+use warnings;
 
+use File::Temp ();
+use File::Spec ();
 
 BEGIN {
 
@@ -61,7 +64,8 @@ require Exporter;
                 remote_refs prompt
                 get_tz_offset get_record
                 credential credential_read credential_write
-                temp_acquire temp_is_locked temp_release temp_reset temp_path);
+                temp_acquire temp_is_locked temp_release temp_reset temp_path
+                unquote_path);
 
 
 =head1 DESCRIPTION
@@ -100,7 +104,7 @@ increase notwithstanding).
 
 
 use Carp qw(carp croak); # but croak is bad - throw instead
-use Error qw(:try);
+use Git::LoadCPAN::Error qw(:try);
 use Cwd qw(abs_path cwd);
 use IPC::Open2 qw(open2);
 use Fcntl qw(SEEK_SET SEEK_CUR);
@@ -188,7 +192,6 @@ sub repository {
                };
 
                if ($dir) {
-                       _verify_require();
                        File::Spec->file_name_is_absolute($dir) or $dir = $opts{Directory} . '/' . $dir;
                        $opts{Repository} = abs_path($dir);
 
@@ -531,9 +534,11 @@ If TIME is not supplied, the current local time is used.
 =cut
 
 sub get_tz_offset {
-       # some systmes don't handle or mishandle %z, so be creative.
+       # some systems don't handle or mishandle %z, so be creative.
        my $t = shift || time;
-       my $gm = timegm(localtime($t));
+       my @t = localtime($t);
+       $t[5] += 1900;
+       my $gm = timegm(@t);
        my $sign = qw( + + - )[ $gm <=> $t ];
        return sprintf("%s%02d%02d", $sign, (gmtime(abs($t - $gm)))[2,1]);
 }
@@ -879,74 +884,6 @@ sub ident_person {
        return "$ident[0] <$ident[1]>";
 }
 
-=item parse_mailboxes
-
-Return an array of mailboxes extracted from a string.
-
-=cut
-
-sub parse_mailboxes {
-       my $re_comment = qr/\((?:[^)]*)\)/;
-       my $re_quote = qr/"(?:[^\"\\]|\\.)*"/;
-       my $re_word = qr/(?:[^]["\s()<>:;@\\,.]|\\.)+/;
-
-       # divide the string in tokens of the above form
-       my $re_token = qr/(?:$re_quote|$re_word|$re_comment|\S)/;
-       my @tokens = map { $_ =~ /\s*($re_token)\s*/g } @_;
-
-       # add a delimiter to simplify treatment for the last mailbox
-       push @tokens, ",";
-
-       my (@addr_list, @phrase, @address, @comment, @buffer) = ();
-       foreach my $token (@tokens) {
-               if ($token =~ /^[,;]$/) {
-                       # if buffer still contains undeterminated strings
-                       # append it at the end of @address or @phrase
-                       if (@address) {
-                               push @address, @buffer;
-                       } else {
-                               push @phrase, @buffer;
-                       }
-
-                       my $str_phrase = join ' ', @phrase;
-                       my $str_address = join '', @address;
-                       my $str_comment = join ' ', @comment;
-
-                       # quote are necessary if phrase contains
-                       # special characters
-                       if ($str_phrase =~ /[][()<>:;@\\,.\000-\037\177]/) {
-                               $str_phrase =~ s/(^|[^\\])"/$1/g;
-                               $str_phrase = qq["$str_phrase"];
-                       }
-
-                       # add "<>" around the address if necessary
-                       if ($str_address ne "" && $str_phrase ne "") {
-                               $str_address = qq[<$str_address>];
-                       }
-
-                       my $str_mailbox = "$str_phrase $str_address $str_comment";
-                       $str_mailbox =~ s/^\s*|\s*$//g;
-                       push @addr_list, $str_mailbox if ($str_mailbox);
-
-                       @phrase = @address = @comment = @buffer = ();
-               } elsif ($token =~ /^\(/) {
-                       push @comment, $token;
-               } elsif ($token eq "<") {
-                       push @phrase, (splice @address), (splice @buffer);
-               } elsif ($token eq ">") {
-                       push @address, (splice @buffer);
-               } elsif ($token eq "@") {
-                       push @address, (splice @buffer), "@";
-               } elsif ($token eq ".") {
-                       push @address, (splice @buffer), ".";
-               } else {
-                       push @buffer, $token;
-               }
-       }
-
-       return @addr_list;
-}
-
 =item hash_object ( TYPE, FILENAME )
 
 Compute the SHA1 object id of the given C<FILENAME> considering it is
@@ -1355,8 +1292,6 @@ sub temp_release {
 sub _temp_cache {
        my ($self, $name) = _maybe_self(@_);
 
-       _verify_require();
-
        my $temp_fd = \$TEMP_FILEMAP{$name};
        if (defined $$temp_fd and $$temp_fd->opened) {
                if ($TEMP_FILES{$$temp_fd}{locked}) {
@@ -1390,11 +1325,6 @@ sub _temp_cache {
        $$temp_fd;
 }
 
-sub _verify_require {
-       eval { require File::Temp; require File::Spec; };
-       $@ and throw Error::Simple($@);
-}
-
 =item temp_reset ( FILEHANDLE )
 
 Truncates and resets the position of the C<FILEHANDLE>.
@@ -1435,6 +1365,95 @@ sub END {
 
 } # %TEMP_* Lexical Context
 
+=item prefix_lines ( PREFIX, STRING [, STRING... ])
+
+Prefixes lines in C<STRING> with C<PREFIX>.
+
+=cut
+
+sub prefix_lines {
+       my $prefix = shift;
+       my $string = join("\n", @_);
+       $string =~ s/^/$prefix/mg;
+       return $string;
+}
+
+=item unquote_path ( PATH )
+
+Unquote a quoted path containing c-escapes as returned by ls-files etc.
+when not using -z or when parsing the output of diff -u.
+
+=cut
+
+{
+       my %cquote_map = (
+               "a" => chr(7),
+               "b" => chr(8),
+               "t" => chr(9),
+               "n" => chr(10),
+               "v" => chr(11),
+               "f" => chr(12),
+               "r" => chr(13),
+               "\\" => "\\",
+               "\042" => "\042",
+       );
+
+       sub unquote_path {
+               local ($_) = @_;
+               my ($retval, $remainder);
+               if (!/^\042(.*)\042$/) {
+                       return $_;
+               }
+               ($_, $retval) = ($1, "");
+               while (/^([^\\]*)\\(.*)$/) {
+                       $remainder = $2;
+                       $retval .= $1;
+                       for ($remainder) {
+                               if (/^([0-3][0-7][0-7])(.*)$/) {
+                                       $retval .= chr(oct($1));
+                                       $_ = $2;
+                                       last;
+                               }
+                               if (/^([\\\042abtnvfr])(.*)$/) {
+                                       $retval .= $cquote_map{$1};
+                                       $_ = $2;
+                                       last;
+                               }
+                               # This is malformed
+                               throw Error::Simple("invalid quoted path $_[0]");
+                       }
+                       $_ = $remainder;
+               }
+               $retval .= $_;
+               return $retval;
+       }
+}
+
+=item get_comment_line_char ( )
+
+Gets the core.commentchar configuration value.
+The value falls-back to '#' if core.commentchar is set to 'auto'.
+
+=cut
+
+sub get_comment_line_char {
+       my $comment_line_char = config("core.commentchar") || '#';
+       $comment_line_char = '#' if ($comment_line_char eq 'auto');
+       $comment_line_char = '#' if (length($comment_line_char) != 1);
+       return $comment_line_char;
+}
+
+=item comment_lines ( STRING [, STRING... ])
+
+Comments lines following core.commentchar configuration.
+
+=cut
+
+sub comment_lines {
+       my $comment_line_char = get_comment_line_char;
+       return prefix_lines("$comment_line_char ", @_);
+}
+
 =back
 
 =head1 ERROR HANDLING
@@ -1670,7 +1689,6 @@ sub DESTROY {
 # Pipe implementation for ActiveState Perl.
 
 package Git::activestate_pipe;
-use strict;
 
 sub TIEHANDLE {
        my ($class, @params) = @_;