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

Last change on this file since 1756 was 1756, checked in by bruno, 6 years ago
  • For opensuse 12.3 patch doesn't support the -s option. Fixed in the conf file
File size: 8.4 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-2012
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;
26
27# Inherit from the "Exporter" module which handles exporting functions.
28 
29use vars qw($VERSION $REVISION @ISA @EXPORT);
30use Exporter;
31 
32# Export, by default, all the functions into the namespace of
33# any code which uses this module.
34 
35our @ISA = qw(Exporter);
36our @EXPORT = qw(pb_get_filters pb_filter_file_pb pb_filter_file_inplace pb_filter_file);
37($VERSION,$REVISION) = pb_version_init();
38
39=pod
40
41=head1 NAME
42
43ProjectBuilder::Filter, part of the project-builder.org
44
45=head1 DESCRIPTION
46
47This module provides filtering functions suitable for pbinit calls.
48
49=over 4
50
51=item B<pb_get_filters>
52
53This function gets all filters to apply. They're cumulative from the less specific to the most specific.
54
55Suffix of those filters is .pbf. Filter all.pbf 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.
56
57The first parameter is the package name.
58The second parameter is OS hash
59
60The function returns a pointer on a hash of filters.
61
62=cut
63
64sub pb_get_filters {
65
66my @ffiles;
67my $pbpkg = shift || die "No package specified";
68my $pbos = shift;
69my $ptr = undef; # returned value pointer on the hash of filters
70my %h;
71
72pb_log(2,"Entering pb_get_filters - pbpkg: $pbpkg - pbos: ".Dumper($pbos)."\n");
73
74# Global filter files first, then package specific
75my @file_basenames = ('all');
76@file_basenames = reverse pb_distro_to_keylist($pbos, 'all') if (defined $pbos);
77# Build list of all filter files
78foreach my $dir ("$ENV{PBROOTDIR}/pbfilter", "$ENV{PBROOTDIR}/$pbpkg/pbfilter") {
79    foreach my $file_basename (@file_basenames) {
80        my $path = "$dir/${file_basename}.pbf";
81        push(@ffiles, $path) if -f $path;
82    }
83}
84
85if (@ffiles) {
86    pb_log(2,"DEBUG ffiles: ".Dumper(\@ffiles)."\n");
87
88    foreach my $f (@ffiles) {
89        pb_log(3,"DEBUG processing filter file $f\n");
90        open(CONF,$f) || next;
91        while(<CONF>)  {
92            if (/^\s*([A-z0-9-_]+)\s+([[A-z0-9-_]+)\s*=\s*(.+)$/) {
93                my ($what, $var, $value) = ($1, $2, $3);
94                pb_log(3,"DEBUG creating entry $what, key $var, value $value\n");
95                # Add support for multi-lines
96                while ($value =~ s/\\\s*$//o) {
97                    $_ = <CONF>;
98                    die "Still processing continuations for $what $var at EOF" if (not defined $_);
99                    s/[\r\n]//go;
100                    $value .= "\n$_";
101                }
102                $h{$what}{$var}=$value;
103            } elsif ((/^\s*#/o) || (/^\s*$/o)) {
104                # ignore
105            } else {
106                chomp();
107                warn "unexpected line '$_' in $f";
108            }
109        }
110        close(CONF);
111    }
112    $ptr = $h{"filter"};
113
114    # TODO: find a place to document it. Why not in this file as pod and also documenting filters ?
115    # Handle transform
116    if (defined $h{transform}) {
117        while (my ($out_key,$spec) = each %{$h{transform}}) {
118            die "Unknown transform for $out_key '$spec' expected <out-key> <transform>" unless $spec =~ /^([\w\-]+)\s+(.+)$/;
119            my ($in_key, $expr) = ($1, $2);
120            local $_ = $ptr->{$in_key} || '';
121            eval $expr;
122            die "Error evaluating tranform for $out_key ($expr): $@" if $@;
123            $ptr->{$out_key} = $_;
124            pb_log(2, "Transform $in_key to $out_key\n$ptr->{$in_key}\n$ptr->{$out_key}\n");
125        }
126    }
127}
128pb_log(2,"DEBUG f:".Dumper($ptr)."\n") if (defined $ptr);
129return($ptr);
130}
131
132=item B<pb_filter_file>
133
134This function applies all filters to files.
135
136It takes 4 parameters.
137
138The first parameter is the file to filter.
139The second parameter is the pointer on the hash of filters. If undefined no filtering will occur.
140The third parameter is the destination file after filtering.
141The fourth parameter is the pointer on the hash of variables to filter (tag, ver, ...)
142
143=cut
144
145sub pb_filter_file {
146
147my $f=shift;
148my $ptr=shift;
149my %filter;
150if (defined $ptr) {
151    %filter=%$ptr;
152} else {
153    %filter = ();
154}
155my $destfile=shift;
156my $pb=shift;
157my $tuple = "unknown";
158$tuple = "$pb->{'pbos'}->{'name'}-$pb->{'pbos'}->{'version'}-$pb->{'pbos'}->{'arch'}" if (defined $pb->{'pbos'});
159
160pb_log(2,"DEBUG: From $f to $destfile (tuple: $tuple)\n");
161pb_log(3,"DEBUG($tuple): pb ".Dumper($pb)."\n");
162pb_mkdir_p(dirname($destfile)) if (! -d dirname($destfile));
163open(DEST,"> $destfile") || die "Unable to create $destfile: $!";
164open(FILE,"$f") || die "Unable to open $f: $!";
165while (<FILE>) {
166    my $line = $_;
167    foreach my $s (keys %filter) {
168        # Process single variables
169        my $tmp = $filter{$s};
170        next if (not defined $tmp);
171        pb_log(3,"DEBUG filter{$s}: $filter{$s}\n");
172        # Expand variables if any single one found
173        if ($tmp =~ /\$/) {
174            pb_log(3,"*** Filtering variable in $tmp ***\n");
175            # Order is important as we need to handle hashes refs before simple vars
176            # (?: introduce a Non-capturing groupings cf man perlretut
177            # We need to avoid handling other VARs (Makefile e.g) so restrict here to $pb type of vars.
178            eval { $tmp =~ s/(\$\w+(?:-\>\{\'\w+\'\})*)/$1/eeg };
179            if (($s =~ /^PBDESC$/) && ($line =~ /^ PBDESC/)) {
180                # if on debian, we need to preserve the space before each desc line
181                pb_log(3,"*** DEBIAN CASE ADDING SPACE ***\n");
182                $tmp =~ s/\$\//\$\/ /g;
183                pb_log(3,"*** tmp:$tmp ***\n");
184            }
185            # Support $/ vars
186            eval { $tmp =~ s/(\$\/)/$1/eeg };
187        } elsif (($s =~ /^PBLOG$/) && ($line =~ /^PBLOG$/)) {
188            # special case for ChangeLog only for pb
189            pb_log(3,"DEBUG filtering PBLOG\n");
190            pb_changelog($pb, \*DEST, $tmp);
191            $tmp = "";
192        } elsif (($s =~ /^PBPATCHSRC$/) && ($line =~ /^PBPATCHSRC$/)) {
193            pb_log(3,"DEBUG($tuple) filtering PBPATCHSRC\n");
194            my $i = 0;
195            pb_log(3,"DEBUG($tuple): pb ".Dumper($pb)."\n");
196            pb_log(3,"DEBUG($tuple): pb/patches/tuple $pb->{'patches'}->{$tuple}\n");
197            if (defined $pb->{'patches'}->{$tuple}) {
198                foreach my $p (split(/,/,$pb->{'patches'}->{$tuple})) {
199                    pb_log(3,"DEBUG($tuple) Adding patch $i ".basename($p)."\n");
200                    print DEST "Patch$i:         ".basename($p).".gz\n";
201                    $i++;
202                }
203            }
204            $tmp = "";
205        } elsif (($s =~ /^PBMULTISRC$/) && ($line =~ /^PBMULTISRC$/)) {
206            pb_log(3,"DEBUG($tuple) filtering PBMULTISRC\n");
207            my $i = 1;
208            if (defined $pb->{'sources'}->{$tuple}) {
209                foreach my $p (split(/,/,$pb->{'sources'}->{$tuple})) {
210                    pb_log(3,"DEBUG($tuple) Adding source $i ".basename($p)."\n");
211                    print DEST "Source$i:         ".basename($p)."\n";
212                    $i++;
213                }
214            }
215            $tmp = "";
216        } elsif (($s =~ /^PBPATCHCMD$/) && ($line =~ /^PBPATCHCMD$/)) {
217            pb_log(3,"DEBUG($tuple) filtering PBPATCHCMD\n");
218            my $i = 0;
219            if (defined $pb->{'patches'}->{$tuple}) {
220                my ($patchcmd,$patchopt) = pb_distro_get_param($pb->{'pbos'},pb_conf_get_if("ospatchcmd","ospatchopt"));
221                foreach my $p (split(/,/,$pb->{'patches'}->{$tuple})) {
222                    pb_log(3,"DEBUG($tuple) Adding patch command $i ($patchopt)\n");
223                    print DEST "%patch$i $patchopt\n";
224                    $i++;
225                }
226            }
227            print DEST "\n";
228            $tmp = "";
229        }
230        $line =~ s|$s|$tmp|g;
231    }
232    print DEST $line;
233}
234close(FILE);
235close(DEST);
236}
237
238=item B<pb_filter_file_inplace>
239
240This function applies all filters to a file in place.
241
242It takes 3 parameters.
243
244The first parameter is the pointer on the hash of filters.
245The second parameter is the destination file after filtering.
246The third parameter is the pointer on the hash of variables to filter (tag, ver, ...)
247
248=cut
249
250# Function which applies filter on files (external call)
251sub pb_filter_file_inplace {
252
253my $ptr=shift;
254my $destfile=shift;
255my $pb=shift;
256
257my $cp = "$ENV{'PBTMP'}/".basename($destfile).".$$";
258copy($destfile,$cp) || die "Unable to copy $destfile to $cp";
259
260pb_filter_file($cp,$ptr,$destfile,$pb);
261unlink $cp;
262}
263
264
265=back
266
267=head1 WEB SITES
268
269The 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/>.
270
271=head1 USER MAILING LIST
272
273None exists for the moment.
274
275=head1 AUTHORS
276
277The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>.
278
279=head1 COPYRIGHT
280
281Project-Builder.org is distributed under the GPL v2.0 license
282described in the file C<COPYING> included with the distribution.
283
284=cut
285
2861;
Note: See TracBrowser for help on using the repository browser.