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
CommitLineData
f0b5ba41
NIS
1#!/usr/bin/perl -w
2my $file = pop(@ARGV);
3my %meta;
4$ENV{'P4PORT'} = 'bactrian:1667';
5$ENV{'P4CLIENT'} = 'camel-linux';
6open(FILE,$file) || die "Cannot open $file:$!";
7while (<FILE>)
8 {
9 if (/^(From|Subject|Date|Message-ID):(.*)$/i)
10 {
11 $meta{lc($1)} = $2;
12 }
13 }
14my @results = `patch @ARGV <$file 2>&1`;
15warn @results;
16my $code = $?;
17warn "$code from patch\n";
18foreach (@results)
19 {
20 if (/patching\s+file\s*(.*?)\s*$/)
21 {
22 push(@edit,$1);
23 }
24 }
25my @have = `p4 have @edit`;
26
27if ($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 }
51else
52 {
53 if (@edit)
54 {
af28e72b 55 System("p4 refresh @edit");
f0b5ba41
NIS
56 }
57 }
58
59sub 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}