author | MattD <mattd@symbian.org> |
Tue, 29 Sep 2009 14:29:23 +0100 | |
changeset 537 | aa5ddb1f5ba0 |
parent 227 | ab5a0930b5c8 |
permissions | -rw-r--r-- |
166 | 1 |
#!/usr/bin/perl |
2 |
||
3 |
||
4 |
use strict; |
|
5 |
||
6 |
#my $cache = "d:/HG_cache/"; |
|
7 |
#my $master = "//v800008/Builds01/"; |
|
8 |
my $cache = shift @ARGV; |
|
9 |
my $csv = shift @ARGV; |
|
10 |
my $generated = shift @ARGV; |
|
11 |
my @recover; |
|
12 |
my @nospace; |
|
13 |
my $exitcode = 0; |
|
14 |
||
15 |
if(defined $cache && defined $generated && defined $csv) |
|
16 |
{ |
|
17 |
print "Cache:$cache\nIn:$csv\nOut:$generated\n"; |
|
18 |
||
19 |
# Format the cache directory path |
|
20 |
if ( $cache !~ /(.*)[\\\/]$/ ) |
|
21 |
{ |
|
22 |
$cache .= "/"; |
|
23 |
} |
|
24 |
||
25 |
open(IN, "<$csv") or die "Couldn't open $csv for reading"; |
|
26 |
open(OUT,">$generated") or die "Couldn't open $generated for writing"; |
|
27 |
my $header = <IN>; |
|
28 |
print OUT $header; |
|
29 |
while( my $line = <IN>) |
|
30 |
{ |
|
31 |
my @args = split(',',$line); |
|
32 |
my $repo = shift @args; |
|
33 |
my $master = ""; |
|
227
ab5a0930b5c8
cachefiles.pl - stopped cache from being excessively flattened, which could cause problems.
MattD <mattd@symbian.org>
parents:
166
diff
changeset
|
34 |
if ( $repo =~ m/^(.*\/)(.*\/(oss|rnd|sfl)\/.*\/)$/i ) |
166 | 35 |
{ |
36 |
$master = $1; |
|
37 |
$repo = $2; |
|
38 |
} |
|
39 |
if(-d $master.$repo.".hg") |
|
40 |
{ |
|
41 |
# print "Found:\t".$master.$repo.".hg\n"; |
|
42 |
my $cmd; |
|
43 |
if(-d $cache.$repo.".hg") # update |
|
44 |
{ |
|
45 |
$cmd = "hg pull -R $cache$repo $master$repo"; |
|
46 |
} |
|
47 |
else #clone |
|
48 |
{ |
|
49 |
#taken from the normal clone script... |
|
50 |
my @dirs = split ('\/', $cache.$repo); |
|
51 |
my $destdir = pop @dirs; |
|
52 |
my $path = ""; |
|
53 |
foreach my $dir (@dirs) |
|
54 |
{ |
|
55 |
$path = ($path eq "") ? $dir : "$path/$dir"; |
|
56 |
if (!-d $path) |
|
57 |
{ |
|
58 |
mkdir $path; |
|
59 |
} |
|
60 |
} |
|
61 |
||
62 |
$cmd = "hg clone -U $master$repo $cache$repo"; |
|
63 |
} |
|
64 |
if(cache($cmd)) |
|
65 |
{ |
|
66 |
print OUT $cache.$repo.",".join(',', @args); |
|
67 |
} |
|
68 |
else |
|
69 |
{ |
|
70 |
print OUT $master.$repo.",".join(',', @args); |
|
71 |
$exitcode = 1; |
|
72 |
} |
|
73 |
} |
|
74 |
else |
|
75 |
{ |
|
76 |
print "Error: cannot find ".$master.$repo.".hg\n"; |
|
77 |
$exitcode = 1; |
|
78 |
} |
|
79 |
} |
|
80 |
||
81 |
close OUT; |
|
82 |
close IN; |
|
83 |
} |
|
84 |
else |
|
85 |
{ |
|
86 |
print "Usage: <cache_path> <source_csv> <generated_csv>"; |
|
87 |
$exitcode = 1; |
|
88 |
} |
|
89 |
||
90 |
foreach my $line (@recover) |
|
91 |
{ |
|
92 |
print "WARNING: HG Recover: $line\n"; |
|
93 |
} |
|
94 |
foreach my $line (@nospace) |
|
95 |
{ |
|
96 |
print "WARNING: No Space: $line\n"; |
|
97 |
} |
|
98 |
||
99 |
exit $exitcode; |
|
100 |
||
101 |
sub cache($cmd) |
|
102 |
{ |
|
103 |
my $cmd = shift; |
|
104 |
print "$cmd\n"; |
|
105 |
||
106 |
open(CMD, "$cmd 2>&1 |") or die "Couldn't execute $cmd"; |
|
107 |
while(my $line = <CMD>) |
|
108 |
{ |
|
109 |
# print $line; |
|
110 |
# parse the output for failures. On fail return 0; |
|
111 |
if($line =~ m/abort/i) |
|
112 |
{ |
|
113 |
print $line; |
|
114 |
if($line =~ m/hg\s+recover/i) |
|
115 |
{ |
|
116 |
push(@recover, $cmd); |
|
117 |
} |
|
118 |
elsif($line =~ m/No\s+space/i) |
|
119 |
{ |
|
120 |
push(@nospace, $cmd); |
|
121 |
} |
|
122 |
close CMD; |
|
123 |
return 0; |
|
124 |
} |
|
125 |
} |
|
126 |
close CMD; |
|
127 |
return 1; |
|
128 |
} |