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

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