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

Last change on this file since 1434 was 1434, checked in by bruno, 7 years ago

r4577@localhost: bruno | 2012-03-18 16:37:37 +0100

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