equal
deleted
inserted
replaced
13 # Extracts output text in <buildlog> context which doesn't belong to <recipe>'s |
13 # Extracts output text in <buildlog> context which doesn't belong to <recipe>'s |
14 |
14 |
15 use strict; |
15 use strict; |
16 use Getopt::Long; |
16 use Getopt::Long; |
17 |
17 |
18 my $DELIVERABLES_DIR = "/deliverables"; |
18 my $RELEASEABLES_DIR = "/releaseables"; |
19 |
19 |
20 my $deliverablesdir = ""; |
20 my $releaseablesdir = ""; |
21 my $packageexpr = ''; |
21 my $packageexpr = ''; |
22 my $help = 0; |
22 my $help = 0; |
23 GetOptions(( |
23 GetOptions(( |
24 'packageexpr:s' => \$packageexpr, |
24 'packageexpr:s' => \$packageexpr, |
25 'deliverablesdir:s' => \$DELIVERABLES_DIR, |
25 'releaseablesdir:s' => \$RELEASEABLES_DIR, |
26 'help!' => \$help |
26 'help!' => \$help |
27 )); |
27 )); |
28 |
28 |
29 $packageexpr =~ m,([^/^\\]+)[/\\]([^/^\\]+),; |
29 $packageexpr =~ m,([^/^\\]+)[/\\]([^/^\\]+),; |
30 my $layer_expr = $1; |
30 my $layer_expr = $1; |
37 print "Usage: perl truclean.pl --packageexpr=LAYER_EXPR/PACKAGE_EXPR [OPTIONS]\n"; |
37 print "Usage: perl truclean.pl --packageexpr=LAYER_EXPR/PACKAGE_EXPR [OPTIONS]\n"; |
38 print "where:\n"; |
38 print "where:\n"; |
39 print "\tLAYER_EXPR can be * or the name of a layer\n"; |
39 print "\tLAYER_EXPR can be * or the name of a layer\n"; |
40 print "\tPACKAGE_EXPR can be * or the name of a package\n"; |
40 print "\tPACKAGE_EXPR can be * or the name of a package\n"; |
41 print "and OPTIONS are:\n"; |
41 print "and OPTIONS are:\n"; |
42 print "\t--deliverablesdir=DIR Use DIR as the root of the deliverables dir (default: $DELIVERABLES_DIR\n"; |
42 print "\t--releaseablesdir=DIR Use DIR as the root of the releaseables dir (default: $RELEASEABLES_DIR\n"; |
43 exit(0); |
43 exit(0); |
44 } |
44 } |
45 |
45 |
46 $DELIVERABLES_DIR = $deliverablesdir if ($deliverablesdir); |
46 $RELEASEABLES_DIR = $releaseablesdir if ($releaseablesdir); |
47 |
47 |
48 my @layers = (); |
48 my @layers = (); |
49 if ($layer_expr eq '*') |
49 if ($layer_expr eq '*') |
50 { |
50 { |
51 opendir(DIR, $DELIVERABLES_DIR); |
51 opendir(DIR, $RELEASEABLES_DIR); |
52 @layers = readdir(DIR); |
52 @layers = readdir(DIR); |
53 closedir(DIR); |
53 closedir(DIR); |
54 @layers = grep(!/^\.\.?$/, @layers); |
54 @layers = grep(!/^\.\.?$/, @layers); |
55 } |
55 } |
56 else |
56 else |
62 for my $layer (@layers) |
62 for my $layer (@layers) |
63 { |
63 { |
64 my @packages = (); |
64 my @packages = (); |
65 if ($package_expr eq '*') |
65 if ($package_expr eq '*') |
66 { |
66 { |
67 opendir(DIR, "$DELIVERABLES_DIR/$layer"); |
67 opendir(DIR, "$RELEASEABLES_DIR/$layer"); |
68 @packages = readdir(DIR); |
68 @packages = readdir(DIR); |
69 closedir(DIR); |
69 closedir(DIR); |
70 @packages = grep(!/^\.\.?$/, @packages); |
70 @packages = grep(!/^\.\.?$/, @packages); |
71 } |
71 } |
72 else |
72 else |
77 |
77 |
78 for my $package (@packages) |
78 for my $package (@packages) |
79 { |
79 { |
80 print "Processing package $layer/$package...\n"; |
80 print "Processing package $layer/$package...\n"; |
81 |
81 |
82 open(FILE, "$DELIVERABLES_DIR/$layer/$package/info.tsv"); |
82 open(FILE, "$RELEASEABLES_DIR/$layer/$package/info.tsv"); |
83 while (<FILE>) |
83 while (<FILE>) |
84 { |
84 { |
85 my $line = $_; |
85 my $line = $_; |
86 |
86 |
87 if ($line =~ m,([^\t]*)\t([^\t]*)\t([^\t]*),) |
87 if ($line =~ m,([^\t]*)\t([^\t]*)\t([^\t]*),) |