18 |
18 |
19 my $RELEASEABLES_DIR_DEFAULT = "\\build_info\\logs\\releaseables"; |
19 my $RELEASEABLES_DIR_DEFAULT = "\\build_info\\logs\\releaseables"; |
20 |
20 |
21 my $releaseablesdir = ""; |
21 my $releaseablesdir = ""; |
22 my $packageexpr = ''; |
22 my $packageexpr = ''; |
|
23 my $dryrun = 0; |
23 my $help = 0; |
24 my $help = 0; |
24 GetOptions(( |
25 GetOptions(( |
25 'packageexpr:s' => \$packageexpr, |
26 'packageexpr:s' => \$packageexpr, |
26 'releaseablesdir:s' => \$releaseablesdir, |
27 'releaseablesdir:s' => \$releaseablesdir, |
|
28 'dryrun!' => \$dryrun, |
27 'help!' => \$help |
29 'help!' => \$help |
28 )); |
30 )); |
29 |
31 |
30 $packageexpr =~ m,([^/^\\]+)[/\\]([^/^\\]+),; |
32 $help = 1 if (!$packageexpr); |
31 my $layer_expr = $1; |
|
32 my $package_expr = $2; |
|
33 $help = 1 if (!$layer_expr or !$package_expr); |
|
34 |
33 |
35 if ($help) |
34 if ($help) |
36 { |
35 { |
37 print "Extracts text which doesn't belong to recipes from a raptor log file\n"; |
36 print <<_EOH; |
38 print "Usage: perl truclean.pl --packageexpr=LAYER_EXPR/PACKAGE_EXPR [OPTIONS]\n"; |
37 truclean |
39 print "where:\n"; |
38 Performs a 'clean' build step, based on the releaseables information, i.e. the |
40 print "\tLAYER_EXPR can be * or the name of a layer\n"; |
39 list of artifacts produced during a PDK build. |
41 print "\tPACKAGE_EXPR can be * or the name of a package\n"; |
40 This cleaning step ensures all the build artifacts produced by the build are |
42 print "and OPTIONS are:\n"; |
41 actually removed even if the source code has changed since the PDK build. |
43 print "\t--releaseablesdir=DIR Use DIR as the root of the releaseables dir (default: $RELEASEABLES_DIR_DEFAULT\n"; |
42 |
|
43 Usage: truclean.pl -p PACKAGE_EXPR [-r RELEASABLES_DIR] [-d] |
|
44 |
|
45 Options: |
|
46 -h, --help Show this help message and exit |
|
47 -p PACKAGE_EXPR Clean (remove) build artifacts belonging to the package |
|
48 or packages indicated by PACKAGE_EXPR. |
|
49 PACKAGE_EXPR is the path (wildcards allowed) of the |
|
50 package, e.g. 'sf/app/camera' or 'sf/mw/*' or '*/*/*'. |
|
51 If the first directory level is not specified then 'sf' |
|
52 is assumed. |
|
53 -r RELEASABLES_DIR Use RELEASEABLES_DIR as root of the releaseable files |
|
54 (default is $RELEASEABLES_DIR_DEFAULT). |
|
55 -d Dry run (Do not remove files for real) |
|
56 _EOH |
44 exit(0); |
57 exit(0); |
45 } |
58 } |
46 |
59 |
47 $releaseablesdir = $RELEASEABLES_DIR_DEFAULT if (!$releaseablesdir); |
60 $releaseablesdir = $RELEASEABLES_DIR_DEFAULT if (!$releaseablesdir); |
48 |
61 |
49 my @layers = (); |
62 $packageexpr =~ s,\\,/,g; |
50 if ($layer_expr eq '*') |
63 $packageexpr =~ s,//,/,g; |
|
64 $packageexpr =~ s,^/,,; |
|
65 if (-d "$releaseablesdir/sf") |
51 { |
66 { |
52 opendir(DIR, $releaseablesdir); |
67 $packageexpr = "sf/$packageexpr" if ($packageexpr =~ m,^(adaptation|app|mw|os|tools),); |
53 @layers = readdir(DIR); |
|
54 closedir(DIR); |
|
55 @layers = grep(!/^\.\.?$/, @layers); |
|
56 } |
68 } |
57 else |
69 |
|
70 my @targetfiles = grep {-f$_} glob("$releaseablesdir/$packageexpr/info.tsv"); |
|
71 print join("\n", @targetfiles); |
|
72 |
|
73 for my $targetfile (@targetfiles) |
58 { |
74 { |
59 push(@layers, $layer_expr); |
75 print "Processing $targetfile...\n"; |
60 } |
|
61 #for (@layers) {print "$_\n"}; |
|
62 |
76 |
63 for my $layer (@layers) |
77 open(FILE, $targetfile); |
64 { |
78 while (<FILE>) |
65 my @packages = (); |
|
66 if ($package_expr eq '*') |
|
67 { |
79 { |
68 opendir(DIR, "$releaseablesdir/$layer"); |
80 my $line = $_; |
69 @packages = readdir(DIR); |
81 |
70 closedir(DIR); |
82 if ($line =~ m,([^\t]*)\t([^\t]*)\t([^\t]*),) |
71 @packages = grep(!/^\.\.?$/, @packages); |
|
72 } |
|
73 else |
|
74 { |
|
75 push(@packages, $package_expr); |
|
76 } |
|
77 #for (@pacakges) {print "$_\n"}; |
|
78 |
|
79 for my $package (@packages) |
|
80 { |
|
81 print "Processing package $layer/$package...\n"; |
|
82 |
|
83 open(FILE, "$releaseablesdir/$layer/$package/info.tsv"); |
|
84 while (<FILE>) |
|
85 { |
83 { |
86 my $line = $_; |
84 my $file = $1; |
|
85 my $type = $2; |
|
86 my $config = $3; |
87 |
87 |
88 if ($line =~ m,([^\t]*)\t([^\t]*)\t([^\t]*),) |
88 if (-f $file) |
89 { |
89 { |
90 my $file = $1; |
90 print "removing file: '$file'\n"; |
91 my $type = $2; |
91 unlink($file) if (!$dryrun); |
92 my $config = $3; |
|
93 |
|
94 if (-f $file) |
|
95 { |
|
96 print "removing file: '$file'\n"; |
|
97 unlink($file); |
|
98 } |
|
99 else |
|
100 { |
|
101 print "WARNING: file '$file' doesn't exist.\n"; |
|
102 } |
|
103 } |
92 } |
104 else |
93 else |
105 { |
94 { |
106 print "WARNING: line '$line' doesn't match the expected tab-separated pattern\n"; |
95 print "WARNING: file '$file' doesn't exist.\n"; |
107 } |
96 } |
108 } |
97 } |
109 close(FILE); |
98 else |
|
99 { |
|
100 print "WARNING: line '$line' doesn't match the expected tab-separated pattern\n"; |
|
101 } |
110 } |
102 } |
|
103 close(FILE); |
111 } |
104 } |