Code

Merge branch 'ab/require-perl-5.8'
authorJunio C Hamano <gitster@pobox.com>
Wed, 27 Oct 2010 04:57:31 +0000 (21:57 -0700)
committerJunio C Hamano <gitster@pobox.com>
Wed, 27 Oct 2010 04:57:31 +0000 (21:57 -0700)
* ab/require-perl-5.8:
  perl: use "use warnings" instead of -w
  perl: bump the required Perl version to 5.8 from 5.6.[21]

1  2 
contrib/examples/git-svnimport.perl
git-cvsimport.perl
git-cvsserver.perl
git-relink.perl
git-send-email.perl
git-svn.perl
gitweb/gitweb.perl

index 6c4cab363361e0e87111984c3803f7ee29526c3d,ead4c04d3f7ca64ed55ff605d7ee8087189a2226..b09ff8f12f7e5b5b6faeaf857d7c61973de8590e
@@@ -1,4 -1,4 +1,4 @@@
- #!/usr/bin/perl -w
+ #!/usr/bin/perl
  
  # This tool is copyright (c) 2005, Matthias Urlichs.
  # It is released under the Gnu Public License, version 2.
@@@ -289,7 -289,7 +289,7 @@@ my $current_rev = $opt_s || 1
  unless(-d $git_dir) {
        system("git init");
        die "Cannot init the GIT db at $git_tree: $?\n" if $?;
 -      system("git read-tree");
 +      system("git read-tree --empty");
        die "Cannot init an empty tree: $?\n" if $?;
  
        $last_branch = $opt_o;
diff --combined git-cvsimport.perl
index 7ab7bbc9ea324021241c4f4779e66f320c7f0ed8,249aeaf17557c4b8f05fdd5f1df5c16d65f0f84c..d27abfe7f32ef47ee8b613293110147ca3006575
@@@ -1,4 -1,4 +1,4 @@@
- #!/usr/bin/perl -w
+ #!/usr/bin/perl
  
  # This tool is copyright (c) 2005, Matthias Urlichs.
  # It is released under the Gnu Public License, version 2.
@@@ -13,6 -13,7 +13,7 @@@
  # The head revision is on branch "origin" by default.
  # You can change that with the '-o' option.
  
+ use 5.008;
  use strict;
  use warnings;
  use Getopt::Long;
@@@ -611,7 -612,7 +612,7 @@@ my %index; # holds filenames of one ind
  unless (-d $git_dir) {
        system(qw(git init));
        die "Cannot init the GIT db at $git_tree: $?\n" if $?;
 -      system(qw(git read-tree));
 +      system(qw(git read-tree --empty));
        die "Cannot init an empty tree: $?\n" if $?;
  
        $last_branch = $opt_o;
diff --combined git-cvsserver.perl
index bd19b855330b62c867a5e76be512563ee17db779,2822bed1fdf6977cd415461bc48630a4996f7084..1b8bff2cac163a6588df397168f57214c30b4784
@@@ -8,13 -8,14 +8,14 @@@
  #### Copyright The Open University UK - 2006.
  ####
  #### Authors: Martyn Smith    <martyn@catalyst.net.nz>
 -####          Martin Langhoff <martin@catalyst.net.nz>
 +####          Martin Langhoff <martin@laptop.org>
  ####
  ####
  #### Released under the GNU Public License, version 2.
  ####
  ####
  
+ use 5.008;
  use strict;
  use warnings;
  use bytes;
@@@ -2680,7 -2681,7 +2681,7 @@@ package GITCVS::log
  #### Copyright The Open University UK - 2006.
  ####
  #### Authors: Martyn Smith    <martyn@catalyst.net.nz>
 -####          Martin Langhoff <martin@catalyst.net.nz>
 +####          Martin Langhoff <martin@laptop.org>
  ####
  ####
  
@@@ -2847,7 -2848,7 +2848,7 @@@ package GITCVS::updater
  #### Copyright The Open University UK - 2006.
  ####
  #### Authors: Martyn Smith    <martyn@catalyst.net.nz>
 -####          Martin Langhoff <martin@catalyst.net.nz>
 +####          Martin Langhoff <martin@laptop.org>
  ####
  ####
  
diff --combined git-relink.perl
index c2a0ef8d5a2794a45908cbcfff1b419ebfc17f8e,af2e305fa39aa1b04ffaca7f026eb2a3dda71b0d..e136732cea80c1594ac02c93cf246e8c77ff89b8
@@@ -6,7 -6,7 +6,7 @@@
  #
  # Scan two git object-trees, and hardlink any common objects between them.
  
- use 5.006;
+ use 5.008;
  use strict;
  use warnings;
  use Getopt::Long;
@@@ -163,7 -163,7 +163,7 @@@ sub link_two_files($$) 
  
  
  sub usage() {
 -      print("Usage: git relink [--safe] <dir> [<dir> ...] <master_dir> \n");
 +      print("Usage: git relink [--safe] <dir>... <master_dir> \n");
        print("All directories should contain a .git/objects/ subdirectory.\n");
        print("Options\n");
        print("\t--safe\t" .
diff --combined git-send-email.perl
index 897bf5960a4220005f4ddc80ec1942136515298b,d10d869912c187868018e5a7b9d97bad51073b64..196efcd5e42a0a61726f26d471cb88fed19aec13
@@@ -1,4 -1,4 +1,4 @@@
- #!/usr/bin/perl -w
+ #!/usr/bin/perl
  #
  # Copyright 2002,2005 Greg Kroah-Hartman <greg@kroah.com>
  # Copyright 2005 Ryan Anderson <ryan@michonline.com>
@@@ -16,6 -16,7 +16,7 @@@
  #    and second line is the subject of the message.
  #
  
+ use 5.008;
  use strict;
  use warnings;
  use Term::ReadLine;
@@@ -24,7 -25,6 +25,7 @@@ use Text::ParseWords
  use Data::Dumper;
  use Term::ANSIColor;
  use File::Temp qw/ tempdir tempfile /;
 +use File::Spec::Functions qw(catfile);
  use Error qw(:try);
  use Git;
  
@@@ -61,7 -61,6 +62,7 @@@ git send-email [options] <file | direct
      --envelope-sender       <str>  * Email envelope sender.
      --smtp-server       <str:int>  * Outgoing SMTP server to use. The port
                                       is optional. Default 'localhost'.
 +    --smtp-server-option    <str>  * Outgoing SMTP server option to use.
      --smtp-server-port      <int>  * Outgoing SMTP server port.
      --smtp-user             <str>  * Username for SMTP-AUTH.
      --smtp-pass             <str>  * Password for SMTP-AUTH; not necessary.
@@@ -72,7 -71,6 +73,7 @@@
  
    Automating:
      --identity              <str>  * Use the sendemail.<id> options.
 +    --to-cmd                <str>  * Email To: via `<str> \$patch_path`
      --cc-cmd                <str>  * Email Cc: via `<str> \$patch_path`
      --suppress-cc           <str>  * author, self, sob, cc, cccmd, body, bodycc, all.
      --[no-]signed-off-by-cc        * Send to Signed-off-by: addresses. Default on.
@@@ -88,7 -86,6 +89,7 @@@
      --[no-]validate                * Perform patch sanity checks. Default on.
      --[no-]format-patch            * understand any non optional arguments as
                                       `git format-patch` ones.
 +    --force                        * Send even if safety checks would prevent it.
  
  EOT
        exit(1);
@@@ -166,7 -163,6 +167,7 @@@ if ($@) 
  my ($quiet, $dry_run) = (0, 0);
  my $format_patch;
  my $compose_filename;
 +my $force = 0;
  
  # Handle interactive edition of files.
  my $multiedit;
@@@ -192,11 -188,9 +193,11 @@@ sub do_edit 
  }
  
  # Variables with corresponding config settings
 -my ($thread, $chain_reply_to, $suppress_from, $signed_off_by_cc, $cc_cmd);
 -my ($smtp_server, $smtp_server_port, $smtp_authuser, $smtp_encryption);
 -my ($identity, $aliasfiletype, @alias_files, @smtp_host_parts, $smtp_domain);
 +my ($thread, $chain_reply_to, $suppress_from, $signed_off_by_cc);
 +my ($to_cmd, $cc_cmd);
 +my ($smtp_server, $smtp_server_port, @smtp_server_options);
 +my ($smtp_authuser, $smtp_encryption);
 +my ($identity, $aliasfiletype, @alias_files, $smtp_domain);
  my ($validate, $confirm);
  my (@suppress_cc);
  my ($auto_8bit_encoding);
@@@ -217,12 -211,10 +218,12 @@@ my %config_bool_settings = 
  my %config_settings = (
      "smtpserver" => \$smtp_server,
      "smtpserverport" => \$smtp_server_port,
 +    "smtpserveroption" => \@smtp_server_options,
      "smtpuser" => \$smtp_authuser,
      "smtppass" => \$smtp_authpass,
 -      "smtpdomain" => \$smtp_domain,
 +    "smtpdomain" => \$smtp_domain,
      "to" => \@to,
 +    "tocmd" => \$to_cmd,
      "cc" => \@initial_cc,
      "cccmd" => \$cc_cmd,
      "aliasfiletype" => \$aliasfiletype,
@@@ -281,7 -273,6 +282,7 @@@ my $rc = GetOptions("sender|from=s" => 
                      "in-reply-to=s" => \$initial_reply_to,
                    "subject=s" => \$initial_subject,
                    "to=s" => \@to,
 +                  "to-cmd=s" => \$to_cmd,
                    "no-to" => \$no_to,
                    "cc=s" => \@initial_cc,
                    "no-cc" => \$no_cc,
                    "no-bcc" => \$no_bcc,
                    "chain-reply-to!" => \$chain_reply_to,
                    "smtp-server=s" => \$smtp_server,
 +                  "smtp-server-option=s" => \@smtp_server_options,
                    "smtp-server-port=s" => \$smtp_server_port,
                    "smtp-user=s" => \$smtp_authuser,
                    "smtp-pass:s" => \$smtp_authpass,
                    "validate!" => \$validate,
                    "format-patch!" => \$format_patch,
                    "8bit-encoding=s" => \$auto_8bit_encoding,
 +                  "force" => \$force,
         );
  
  unless ($rc) {
@@@ -523,7 -512,7 +524,7 @@@ while (defined(my $f = shift @ARGV)) 
                opendir(DH,$f)
                        or die "Failed to opendir $f: $!";
  
 -              push @files, grep { -f $_ } map { +$f . "/" . $_ }
 +              push @files, grep { -f $_ } map { catfile($f, $_) }
                                sort readdir(DH);
                closedir(DH);
        } elsif ((-f $f or -p $f) and !check_file_rev_conflict($f)) {
@@@ -714,16 -703,6 +715,16 @@@ if (!defined $auto_8bit_encoding && sca
                                  default => "UTF-8");
  }
  
 +if (!$force) {
 +      for my $f (@files) {
 +              if (get_patch_subject($f) =~ /\*\*\* SUBJECT HERE \*\*\*/) {
 +                      die "Refusing to send because the patch\n\t$f\n"
 +                              . "has the template subject '*** SUBJECT HERE ***'. "
 +                              . "Pass --force if you really want to send.\n";
 +              }
 +      }
 +}
 +
  my $prompting = 0;
  if (!defined $sender) {
        $sender = $repoauthor || $repocommitter || '';
        $prompting++;
  }
  
 -if (!@to) {
 +if (!@to && !defined $to_cmd) {
        my $to = ask("Who should the emails be sent to? ");
        push @to, parse_address_line($to) if defined $to; # sanitized/validated later
        $prompting++;
@@@ -917,7 -896,7 +918,7 @@@ sub sanitize_address 
  
  sub valid_fqdn {
        my $domain = shift;
 -      return !($^O eq 'darwin' && $domain =~ /\.local$/) && $domain =~ /\./;
 +      return defined $domain && !($^O eq 'darwin' && $domain =~ /\.local$/) && $domain =~ /\./;
  }
  
  sub maildomain_net {
@@@ -1037,8 -1016,6 +1038,8 @@@ X-Mailer: git-send-email $gitversio
                }
        }
  
 +      unshift (@sendmail_parameters, @smtp_server_options);
 +
        if ($dry_run) {
                # We don't want to send the email.
        } elsif ($smtp_server =~ m#^/#) {
@@@ -1262,10 -1239,21 +1263,10 @@@ foreach my $t (@files) 
        }
        close F;
  
 -      if (defined $cc_cmd && !$suppress_cc{'cccmd'}) {
 -              open(F, "$cc_cmd \Q$t\E |")
 -                      or die "(cc-cmd) Could not execute '$cc_cmd'";
 -              while(<F>) {
 -                      my $c = $_;
 -                      $c =~ s/^\s*//g;
 -                      $c =~ s/\n$//g;
 -                      next if ($c eq $sender and $suppress_from);
 -                      push @cc, $c;
 -                      printf("(cc-cmd) Adding cc: %s from: '%s'\n",
 -                              $c, $cc_cmd) unless $quiet;
 -              }
 -              close F
 -                      or die "(cc-cmd) failed to close pipe to '$cc_cmd'";
 -      }
 +      push @to, recipients_cmd("to-cmd", "to", $to_cmd, $t)
 +              if defined $to_cmd;
 +      push @cc, recipients_cmd("cc-cmd", "cc", $cc_cmd, $t)
 +              if defined $cc_cmd && !$suppress_cc{'cccmd'};
  
        if ($broken_encoding{$t} && !$has_content_type) {
                $has_content_type = 1;
        $message_id = undef;
  }
  
 +# Execute a command (e.g. $to_cmd) to get a list of email addresses
 +# and return a results array
 +sub recipients_cmd {
 +      my ($prefix, $what, $cmd, $file) = @_;
 +
 +      my $sanitized_sender = sanitize_address($sender);
 +      my @addresses = ();
 +      open(F, "$cmd \Q$file\E |")
 +          or die "($prefix) Could not execute '$cmd'";
 +      while(<F>) {
 +              my $address = $_;
 +              $address =~ s/^\s*//g;
 +              $address =~ s/\s*$//g;
 +              $address = sanitize_address($address);
 +              next if ($address eq $sanitized_sender and $suppress_from);
 +              push @addresses, $address;
 +              printf("($prefix) Adding %s: %s from: '%s'\n",
 +                     $what, $address, $cmd) unless $quiet;
 +              }
 +      close F
 +          or die "($prefix) failed to close pipe to '$cmd'";
 +      return @addresses;
 +}
 +
  cleanup_compose_files();
  
  sub cleanup_compose_files() {
diff --combined git-svn.perl
index 18cfb2466d11aa28a795e3dabac70e236061fbe9,d2922245aa76448e551a4b427e7c8c721527952d..757de82161e05b9d12c489efeff05c7fec341fe4
@@@ -1,6 -1,7 +1,7 @@@
  #!/usr/bin/env perl
  # Copyright (C) 2006, Eric Wong <normalperson@yhbt.net>
  # License: GPL v2 or later
+ use 5.008;
  use warnings;
  use strict;
  use vars qw/  $AUTHOR $VERSION
@@@ -1513,8 -1514,7 +1514,8 @@@ sub cmt_sha2rev_batch 
  
  sub working_head_info {
        my ($head, $refs) = @_;
 -      my @args = ('log', '--no-color', '--first-parent', '--pretty=medium');
 +      my @args = qw/log --no-color --no-decorate --first-parent
 +                    --pretty=medium/;
        my ($fh, $ctx) = command_output_pipe(@args, $head);
        my $hash;
        my %max;
@@@ -3119,10 -3119,9 +3120,10 @@@ sub _rev_list 
  sub check_cherry_pick {
        my $base = shift;
        my $tip = shift;
 +      my $parents = shift;
        my @ranges = @_;
        my %commits = map { $_ => 1 }
 -              _rev_list("--no-merges", $tip, "--not", $base);
 +              _rev_list("--no-merges", $tip, "--not", $base, @$parents);
        for my $range ( @ranges ) {
                delete @commits{_rev_list($range)};
        }
@@@ -3298,7 -3297,6 +3299,7 @@@ sub find_extra_svn_parents 
                # double check that there are no missing non-merge commits
                my (@incomplete) = check_cherry_pick(
                        $merge_base, $merge_tip,
 +                      $parents,
                        @$ranges,
                       );
  
diff --combined gitweb/gitweb.perl
index 8d7e4c5e49f41c7d864a3399f40deda722c1aa2d,e645d4a821f7eab28911f508923abd3e9a9dc53b..253f41adc9e64105bf9d1642102b20bba6bc5f20
@@@ -7,6 -7,7 +7,7 @@@
  #
  # This program is licensed under the GPLv2
  
+ use 5.008;
  use strict;
  use warnings;
  use CGI qw(:standard :escapeHTML -nosticky);
@@@ -165,12 -166,6 +166,12 @@@ our @diff_opts = ('-M'); # taken from g
  # the gitweb domain.
  our $prevent_xss = 0;
  
 +# Path to the highlight executable to use (must be the one from
 +# http://www.andre-simon.de due to assumptions about parameters and output).
 +# Useful if highlight is not installed on your webserver's PATH.
 +# [Default: highlight]
 +our $highlight_bin = "++HIGHLIGHT_BIN++";
 +
  # information about snapshot formats that gitweb is capable of serving
  our %known_snapshot_formats = (
        # name => {
@@@ -780,10 -775,10 +781,10 @@@ sub evaluate_path_info 
                'history',
        );
  
 -      # we want to catch
 +      # we want to catch, among others
        # [$hash_parent_base[:$file_parent]..]$hash_parent[:$file_name]
        my ($parentrefname, $parentpathname, $refname, $pathname) =
 -              ($path_info =~ /^(?:(.+?)(?::(.+))?\.\.)?(.+?)(?::(.+))?$/);
 +              ($path_info =~ /^(?:(.+?)(?::(.+))?\.\.)?([^:]+?)?(?::(.+))?$/);
  
        # first, analyze the 'current' part
        if (defined $pathname) {
                # hash_base instead. It should also be noted that hand-crafted
                # links having 'history' as an action and no pathname or hash
                # set will fail, but that happens regardless of PATH_INFO.
 -              $input_params{'action'} ||= "shortlog";
 -              if (grep { $_ eq $input_params{'action'} } @wants_base) {
 +              if (defined $parentrefname) {
 +                      # if there is parent let the default be 'shortlog' action
 +                      # (for http://git.example.com/repo.git/A..B links); if there
 +                      # is no parent, dispatch will detect type of object and set
 +                      # action appropriately if required (if action is not set)
 +                      $input_params{'action'} ||= "shortlog";
 +              }
 +              if ($input_params{'action'} &&
 +                  grep { $_ eq $input_params{'action'} } @wants_base) {
                        $input_params{'hash_base'} ||= $refname;
                } else {
                        $input_params{'hash'} ||= $refname;
@@@ -3373,8 -3361,7 +3374,8 @@@ sub run_highlighter 
        close $fd
                or die_error(404, "Reading blob failed");
        open $fd, quote_command(git_cmd(), "cat-file", "blob", $hash)." | ".
 -                "highlight --xhtml --fragment --syntax $syntax |"
 +                quote_command($highlight_bin).
 +                " --xhtml --fragment --syntax $syntax |"
                or die_error(500, "Couldn't open file or run syntax highlighter");
        return $fd;
  }