This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
When applying patch via Porting/apply fails, do p4 refresh
[perl5.git] / Porting / apply
1 #!/usr/bin/perl -w
2 my $file = pop(@ARGV);
3 my %meta;
4 $ENV{'P4PORT'} = 'bactrian:1667';
5 $ENV{'P4CLIENT'} = 'camel-linux';
6 open(FILE,$file) || die "Cannot open $file:$!";
7 while (<FILE>)
8  {
9   if (/^(From|Subject|Date|Message-ID):(.*)$/i)
10    {
11     $meta{lc($1)} = $2;
12    }
13  }
14 my @results = `patch @ARGV <$file 2>&1`;
15 warn @results;
16 my $code = $?;
17 warn "$code from patch\n";
18 foreach (@results)
19  {
20   if (/patching\s+file\s*(.*?)\s*$/)
21    {
22     push(@edit,$1);
23    }
24  }
25 my @have = `p4 have @edit`;
26
27 if ($code == 0)
28  {
29   System("p4 edit @edit");
30   open(PIPE,"|p4 change -i") || die "Cannot open pipe to p4:$!";
31   print PIPE "Change: new\n";
32   print PIPE "Description:\n";
33   foreach my $key (qw(Subject From Date Message-Id))
34    {
35     if (exists $meta{lc($key)})
36      {
37       print PIPE "\t$key: ",$meta{lc($key)},"\n";
38       print "$key: ",$meta{lc($key)},"\n";
39      }
40    }
41   print PIPE "Files:\n";
42   foreach (@have)
43    {
44     if (m,^(.*)#,)
45      {
46       print PIPE "\t$1\n"
47      }
48    }
49   close(PIPE);
50  }
51 else
52  {
53   if (@edit)
54    {
55     System("p4 refresh @edit");
56    }
57  }
58
59 sub System
60 {
61  my $cmd = join(' ',@_);
62  warn "$cmd\n";
63  if (fork)
64   {
65    wait;
66   }
67  else
68   {
69    _exit(exec $cmd);
70   }
71 }