source: devel/pb/lib/ProjectBuilder/Filter.pm

Last change on this file was 2287, checked in by bruno, 22 months ago

Fix usage of labels in env var (normalize with 'LABEL'

File size: 9.2 KB
Line 
1#!/usr/bin/perl -w
2#
3# ProjectBuilder Filter module
4# Filtering subroutines brought by the the Project-Builder project
5# which can be easily used by pbinit
6#
7# $Id$
8#
9# Copyright B. Cornec 2007-2016
10# Eric Anderson's changes are (c) Copyright 2012 Hewlett Packard
11# Provided under the GPL v2
12
13package ProjectBuilder::Filter;
14
15use strict 'vars';
16use Data::Dumper;
17use English;
18use File::Basename;
19use File::Copy;
20use lib qw (lib);
21use ProjectBuilder::Version;
22use ProjectBuilder::Base;
23use ProjectBuilder::Conf;
24use ProjectBuilder::Distribution;
25use ProjectBuilder::Changelog;
26use ProjectBuilder::VCS;
27
28# Inherit from the "Exporter" module which handles exporting functions.
29 
30use vars qw($VERSION $REVISION @ISA @EXPORT);
31use Exporter;
32 
33# Export, by default, all the functions into the namespace of
34# any code which uses this module.
35 
36our @ISA = qw(Exporter);
37our @EXPORT = qw(pb_get_filters pb_filter_file_pb pb_filter_file_inplace pb_filter_file pb_filter_var_print);
38($VERSION,$REVISION) = pb_version_init();
39
40=pod
41
42=head1 NAME
43
44ProjectBuilder::Filter, part of the project-builder.org
45
46=head1 DESCRIPTION
47
48This module provides filtering functions suitable for pbinit calls.
49
50=over 4
51
52=item B<pb_get_filters>
53
54This function gets all filters to apply. They're cumulative from the less specific to the most specific.
55
56Suffix of those filters is .yml. Filter all.yml applies to whatever distribution. The pbfilter directory may be global under pbconf or per package, for overloading values. Then in order filters are loaded for distribution type, distribution family, distribution name, distribution name-version.
57
58The first parameter is the package name.
59The second parameter is OS hash
60
61The function returns a pointer on a hash of filters.
62
63=cut
64
65sub pb_get_filters {
66
67my @ffiles;
68my @ffilestoconvert;
69my $pbpkg = shift || die "No package specified";
70my $pbos = shift;
71my $ptr = undef; # returned value pointer on the hash of filters
72my $lh;
73
74pb_log(2,"Entering pb_get_filters - pbpkg: $pbpkg - pbos: ".Dumper($pbos)."\n");
75
76# Global filter files first, then package specific
77my @file_basenames = ('all');
78@file_basenames = reverse pb_distro_to_keylist($pbos, 'all') if (defined $pbos);
79# Build list of all filter files
80foreach my $dir ("$ENV{'PBROOTDIR'}/pbfilter", "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter") {
81    foreach my $file_basename (@file_basenames) {
82        my $path = "$dir/${file_basename}.yml";
83        if (-f $path) {
84            push(@ffiles, $path);
85        } else {
86            my $path2 = "$dir/${file_basename}.pbf";
87            push(@ffilestoconvert, $path2) if (-f $path2);
88        }
89    }
90}
91
92# Convert all old filter files into new ones
93if (@ffilestoconvert) {
94    foreach my $f (@ffilestoconvert) {
95        my $fyml = $f;
96        $fyml =~ s/\.pbf/.yml/;
97        pb_vcs_conf_update_v0($f,$fyml);
98        push(@ffiles, $fyml);
99    }
100}
101
102if (@ffiles) {
103    pb_log(2,"DEBUG ffiles: ".Dumper(\@ffiles)."\n");
104
105    foreach my $f (@ffiles) {
106        pb_log(3,"DEBUG processing filter file $f\n");
107        $lh = pb_conf_cache($f,$lh);
108        pb_log(2, "filter hash is:\n".Dumper($lh)."\n");
109    }
110    $ptr = $lh->{"filter"};
111
112    # TODO: find a place to document it. Why not in this file as pod and also documenting filters ?
113    # Handle transform
114    if (defined $lh->{transform}) {
115        while (my ($out_key,$spec) = each %{$lh->{transform}}) {
116            die "Unknown transform for $out_key '$spec' expected <out-key> <transform>" unless $spec =~ /^([\w\-]+)\s+(.+)$/;
117            my ($in_key, $expr) = ($1, $2);
118            local $_ = $ptr->{$in_key} || '';
119            eval $expr;
120            die "Error evaluating tranform for $out_key ($expr): $@" if $@;
121            $ptr->{$out_key} = $_;
122            pb_log(2, "Transform $in_key to $out_key\n$ptr->{$in_key}\n$ptr->{$out_key}\n");
123        }
124    }
125}
126pb_log(2,"DEBUG f:".Dumper($ptr)."\n") if (defined $ptr);
127return($ptr);
128}
129
130=item B<pb_filter_file>
131
132This function applies all filters to files.
133
134It takes 4 parameters.
135
136The first parameter is the file to filter.
137The second parameter is the pointer on the hash of filters. If undefined no filtering will occur.
138The third parameter is the destination file after filtering.
139The fourth parameter is the pointer on the hash of variables to filter (tag, ver, ...)
140
141=cut
142
143sub pb_filter_file {
144
145my $f=shift;
146my $ptr=shift;
147my %filter;
148if (defined $ptr) {
149    %filter=%$ptr;
150} else {
151    %filter = ();
152}
153my $destfile=shift;
154my $pb=shift;
155my $tuple = "unknown";
156$tuple = "$pb->{'pbos'}->{'name'}-$pb->{'pbos'}->{'version'}-$pb->{'pbos'}->{'arch'}" if (defined $pb->{'pbos'});
157
158pb_log(2,"DEBUG: From $f to $destfile (tuple: $tuple)\n");
159pb_log(3,"DEBUG($tuple): pb ".Dumper($pb)."\n");
160pb_mkdir_p(dirname($destfile)) if (! -d dirname($destfile));
161open(DEST,"> $destfile") || die "Unable to create $destfile: $!";
162open(FILE,"$f") || die "Unable to open $f: $!";
163while (<FILE>) {
164    my $line = $_;
165    foreach my $s (keys %filter) {
166        # Process single variables
167        my $tmp = $filter{$s};
168        next if (not defined $tmp);
169        pb_log(3,"DEBUG filter{$s}: $filter{$s}\n");
170        # Expand variables if any single one found
171        if ($tmp =~ /\$/) {
172            pb_log(3,"*** Filtering variable in $tmp ***\n");
173            # Order is important as we need to handle hashes refs before simple vars
174            # (?: introduce a Non-capturing groupings cf man perlretut
175            # We need to avoid handling other VARs (Makefile e.g) so restrict here to $pb type of vars.
176            eval { $tmp =~ s/(\$\w+(?:-\>\{\'\w+\'\})*)/$1/eeg };
177            if (($s =~ /^PBDESC$/) && ($line =~ /^ PBDESC/)) {
178                # if on debian, we need to preserve the space before each desc line
179                pb_log(3,"*** DEBIAN CASE ADDING SPACE ***\n");
180                $tmp =~ s/\$\//\$\/ /g;
181                pb_log(3,"*** tmp:$tmp ***\n");
182            }
183            # Support $/ vars
184            eval { $tmp =~ s/(\$\/)/$1/eeg };
185        } elsif (($s =~ /^PBLOG$/) && ($line =~ /^PBLOG$/)) {
186            # special case for ChangeLog only for pb
187            pb_log(3,"DEBUG filtering PBLOG\n");
188            pb_changelog($pb, \*DEST, $tmp);
189            $tmp = "";
190        } elsif (($s =~ /^PBPATCHSRC$/) && ($line =~ /^PBPATCHSRC$/)) {
191            pb_log(3,"DEBUG($tuple) filtering PBPATCHSRC\n");
192            my $i = 0;
193            pb_log(3,"DEBUG($tuple): pb ".Dumper($pb)."\n");
194            pb_log(3,"DEBUG($tuple): pb/patches/tuple $pb->{'patches'}->{$tuple}\n");
195            if (defined $pb->{'patches'}->{$tuple}) {
196                foreach my $p (split(/,/,$pb->{'patches'}->{$tuple})) {
197                    pb_log(3,"DEBUG($tuple) Adding patch $i ".basename($p)."\n");
198                    print DEST "Patch$i:         ".basename($p).".gz\n";
199                    $i++;
200                }
201            }
202            $tmp = "";
203        } elsif (($s =~ /^PBMULTISRC$/) && ($line =~ /^PBMULTISRC$/)) {
204            pb_log(3,"DEBUG($tuple) filtering PBMULTISRC\n");
205            my $i = 1;
206            if (defined $pb->{'sources'}->{$tuple}) {
207                foreach my $p (split(/,/,$pb->{'sources'}->{$tuple})) {
208                    pb_log(3,"DEBUG($tuple) Adding source $i ".basename($p)."\n");
209                    print DEST "Source$i:         ".basename($p)."\n";
210                    $i++;
211                }
212            }
213            $tmp = "";
214        } elsif (($s =~ /^PBPATCHCMD$/) && ($line =~ /^PBPATCHCMD$/)) {
215            pb_log(3,"DEBUG($tuple) filtering PBPATCHCMD\n");
216            my $i = 0;
217            if (defined $pb->{'patches'}->{$tuple}) {
218                my ($patchcmd,$patchopt) = pb_distro_get_param($pb->{'pbos'},pb_conf_get_if("ospatchcmd","ospatchopt"));
219                foreach my $p (split(/,/,$pb->{'patches'}->{$tuple})) {
220                    pb_log(3,"DEBUG($tuple) Adding patch command $i ($patchopt)\n");
221                    print DEST "%patch$i $patchopt\n";
222                    $i++;
223                }
224            }
225            print DEST "\n";
226            $tmp = "";
227        }
228        $line =~ s|$s|$tmp|g;
229    }
230    print DEST $line;
231}
232close(FILE);
233close(DEST);
234}
235
236=item B<pb_filter_file_inplace>
237
238This function applies all filters to a file in place.
239
240It takes 3 parameters.
241
242The first parameter is the pointer on the hash of filters.
243The second parameter is the destination file after filtering.
244The third parameter is the pointer on the hash of variables to filter (tag, ver, ...)
245
246=cut
247
248# Function which applies filter on files (external call)
249sub pb_filter_file_inplace {
250
251my $ptr=shift;
252my $destfile=shift;
253my $pb=shift;
254
255my $cp = "$ENV{'PBTMP'}/".basename($destfile).".$$";
256copy($destfile,$cp) || die "Unable to copy $destfile to $cp";
257
258pb_filter_file($cp,$ptr,$destfile,$pb);
259unlink $cp;
260}
261
262
263=item B<pb_filter_var_print>
264
265This function prints every variable expanded in order to help debug stacking issues with conf files. If a VM/VE/RM is given restrict display to this distribution. If parameters are passed, restrict again the display to that package only.
266
267=cut
268
269sub pb_filter_var_print {
270
271my $pbos = shift;
272my @keys = @_;
273my $ptr = undef;
274
275if ($#keys == -1) {
276    pb_log(0,"Full pb variables for project $ENV{'PBPROJ'}\n");
277    pb_log(0,"============================================\n");
278}
279if (defined $ENV{'PBV'}) {
280    pb_log(0,"Distribution $ENV{'PBV'}\n");
281    pb_log(0,"========================\n");
282} else {
283    pb_log(0,"Local Distribution\n");
284    pb_log(0,"==================\n");
285}
286
287foreach my $k (@keys) {
288    $ptr = pb_get_filters($k,$pbos);
289    pb_log(0,"Package $k\n");
290    pb_log(0,"==================\n");
291    foreach my $f (sort keys %$ptr) {
292        pb_log(0,"Filter $f => $ptr->{$f}\n");
293    }
294    pb_log(0,"==================\n");
295}
296}
297
298
299=back
300
301=head1 WEB SITES
302
303The main Web site of the project is available at L<http://www.project-builder.org/>. Bug reports should be filled using the trac instance of the project at L<http://trac.project-builder.org/>.
304
305=head1 USER MAILING LIST
306
307None exists for the moment.
308
309=head1 AUTHORS
310
311The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>.
312
313=head1 COPYRIGHT
314
315Project-Builder.org is distributed under the GPL v2.0 license
316described in the file C<COPYING> included with the distribution.
317
318=cut
319
3201;
Note: See TracBrowser for help on using the repository browser.