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

Last change on this file since 417 was 417, checked in by bruno, 11 years ago
  • Reintegrates $pbproj as variable for filter functions (needed for PBPROJ expansion)
  • Fix pbinit using perl functions support
  • Adds a virtual pbinit action support in pb_env_init
File size: 9.1 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::Base;
21use ProjectBuilder::Changelog;
22
23# Inherit from the "Exporter" module which handles exporting functions.
24 
25use Exporter;
26 
27# Export, by default, all the functions into the namespace of
28# any code which uses this module.
29 
30our @ISA = qw(Exporter);
31our @EXPORT = qw(pb_get_filters pb_filter_file_pb pb_filter_file_inplace pb_filter_file);
32
33=pod
34
35=head1 NAME
36
37ProjectBuilder::Filter, part of the project-builder.org
38
39=head1 DESCRIPTION
40
41This module provides filtering functions suitable for pbinit calls.
42
43=item B<pb_get_filters>
44
45This function gets all filters to apply. They're cumulative from the less specific to the most specific.
46
47Suffix 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.
48
49The first parameter is the package name.
50The second parameter is the distribution type.
51The third parameter is the distribution family.
52The fourth parameter is the distribution name.
53The fifth parameter is the distribution version.
54
55The function returns a pointer on a hash of filters.
56
57=cut
58
59sub pb_get_filters {
60
61my @ffiles;
62my ($ffile00, $ffile0, $ffile1, $ffile2, $ffile3);
63my ($mfile00, $mfile0, $mfile1, $mfile2, $mfile3);
64my $pbpkg = shift || die "No package specified";
65my $dtype = shift || "";
66my $dfam = shift || "";
67my $ddir = shift || "";
68my $dver = shift || "";
69my $ptr = undef; # returned value pointer on the hash of filters
70my %h;
71
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    $mfile0 = "$ENV{'PBROOTDIR'}/pbfilter/$dtype.pbf" if (-f "$ENV{'PBROOTDIR'}/pbfilter/$dtype.pbf");
76    $mfile1 = "$ENV{'PBROOTDIR'}/pbfilter/$dfam.pbf" if (-f "$ENV{'PBROOTDIR'}/pbfilter/$dfam.pbf");
77    $mfile2 = "$ENV{'PBROOTDIR'}/pbfilter/$ddir.pbf" if (-f "$ENV{'PBROOTDIR'}/pbfilter/$ddir.pbf");
78    $mfile3 = "$ENV{'PBROOTDIR'}/pbfilter/$ddir-$dver.pbf" if (-f "$ENV{'PBROOTDIR'}/pbfilter/$ddir-$dver.pbf");
79
80    push @ffiles,$mfile00 if (defined $mfile00);
81    push @ffiles,$mfile0 if (defined $mfile0);
82    push @ffiles,$mfile1 if (defined $mfile1);
83    push @ffiles,$mfile2 if (defined $mfile2);
84    push @ffiles,$mfile3 if (defined $mfile3);
85}
86
87if (-d "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter") {
88    $ffile00 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/all.pbf" if (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/all.pbf");
89    $ffile0 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$dtype.pbf" if (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$dtype.pbf");
90    $ffile1 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$dfam.pbf" if (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$dfam.pbf");
91    $ffile2 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$ddir.pbf" if (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$ddir.pbf");
92    $ffile3 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$ddir-$dver.pbf" if (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$ddir-$dver.pbf");
93
94    push @ffiles,$ffile00 if (defined $ffile00);
95    push @ffiles,$ffile0 if (defined $ffile0);
96    push @ffiles,$ffile1 if (defined $ffile1);
97    push @ffiles,$ffile2 if (defined $ffile2);
98    push @ffiles,$ffile3 if (defined $ffile3);
99}
100if (@ffiles) {
101    pb_log(2,"DEBUG ffiles: ".Dumper(\@ffiles)."\n");
102
103    foreach my $f (@ffiles) {
104        open(CONF,$f) || next;
105        while(<CONF>)  {
106            if (/^\s*([A-z0-9-_]+)\s+([[A-z0-9-_]+)\s*=\s*(.+)$/) {
107                $h{$1}{$2}=$3;
108            }
109        }
110        close(CONF);
111
112        $ptr = $h{"filter"};
113        pb_log(2,"DEBUG f:".Dumper($ptr)."\n");
114    }
115}
116return($ptr);
117}
118
119=item B<pb_filter_file_pb>
120
121This function applies all filters to pb build files.
122
123It takes 15 parameters. To be filtered a variable has to be passed to that function.
124
125The first parameter is the file to filter.
126The second parameter is the pointer on the hash of filters.
127The third parameter is the destination file after filtering.
128The fourth parameter is the distribution type.
129The fifth parameter is the suffix of the distribution.
130The sixth parameter is the package name.
131The seventh parameter is the version of the package.
132The eighth parameter is the tag of the package.
133The nineth parameter is the revision of the package.
134The tenth parameter is the current date.
135The eleventh parameter is the list of required packages.
136The twelveth parameter is the list of optional packages.
137The thirteenth parameter is the packager name.
138The fourteenth parameter is the changelog.
139The fifteenth parameter is the project.
140
141=cut
142
143sub pb_filter_file_pb {
144
145my $f=shift;
146my $ptr=shift;
147my %filter=%$ptr;
148my $destfile=shift;
149my $dtype=shift;
150my $pbsuf=shift;
151my $pbpkg=shift;
152my $pbver=shift;
153my $pbtag=shift;
154my $pbrev=shift;
155my $pbdate=shift;
156my $defpkgdir = shift;
157my $extpkgdir = shift;
158my $pbpackager = shift;
159my $chglog = shift || undef;
160my $pbproj = shift;
161
162pb_log(2,"DEBUG: From $f to $destfile\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        pb_log(2,"DEBUG filter{$s}: $filter{$s}\n");
171        my $tmp = $filter{$s};
172        next if (not defined $tmp);
173        # Expand variables if any single one found
174        pb_log(2,"DEBUG tmp: $tmp\n");
175        if ($tmp =~ /\$/) {
176            eval { $tmp =~ s/(\$\w+)/$1/eeg };
177        # special case for ChangeLog only for pb
178        } elsif (($s =~ /^PBLOG$/) && ($line =~ /^PBLOG$/)) {
179            my $p = $defpkgdir->{$pbpkg};
180            $p = $extpkgdir->{$pbpkg} if (not defined $p);
181            pb_changelog($dtype, $pbpkg, $pbver, $pbtag, $pbsuf, $p, \*DEST, $tmp, $chglog);
182            $tmp = "";
183        }
184        $line =~ s|$s|$tmp|;
185    }
186    print DEST $line;
187}
188close(FILE);
189close(DEST);
190}
191
192=item B<pb_filter_file_inplace>
193
194This function applies all filters to a file in place.
195
196It takes 9 parameters.
197
198The first parameter is the pointer on the hash of filters.
199The second parameter is the destination file after filtering.
200The third parameter is the package name.
201The fourth parameter is the version of the package.
202The fifth parameter is the tag of the package.
203The sixth parameter is the revision of the package.
204The seventh parameter is the current date.
205The eighth parameter is the packager name.
206The nineth parameter is the project name.
207
208=cut
209
210# Function which applies filter on files (external call)
211sub pb_filter_file_inplace {
212
213my $ptr=shift;
214my %filter=%$ptr;
215my $destfile=shift;
216my $pbpkg=shift;
217my $pbver=shift;
218my $pbtag=shift;
219my $pbrev=shift;
220my $pbdate=shift;
221my $pbpackager=shift;
222my $pbproj=shift;
223
224my $cp = "$ENV{'PBTMP'}/".basename($destfile);
225copy($destfile,$cp) || die "Unable to create $cp";
226
227pb_filter_file($cp,$ptr,$destfile,$pbpkg,$pbver,$pbtag,$pbrev,$pbdate,$pbpackager,$pbproj);
228unlink $cp;
229}
230
231=item B<pb_filter_file>
232
233This function applies all filters on a file to generate a new filtered one.
234
235It takes 10 parameters. To be filtered a variable has to be passed to that function.
236
237The first parameter is the original file to filter.
238The second parameter is the pointer on the hash of filters.
239The third parameter is the destination file after filtering.
240The fourth parameter is the package name.
241The fifth parameter is the version of the package.
242The sixth parameter is the tag of the package.
243The seventh parameter is the revision of the package.
244The eighth parameter is the current date.
245The nineth parameter is the packager name.
246The tenth parameter is the project name.
247
248=cut
249
250
251# Function which applies filter on files (external call)
252sub pb_filter_file {
253
254my $f=shift;
255my $ptr=shift;
256my %filter=%$ptr;
257my $destfile=shift;
258my $pbpkg=shift;
259my $pbver=shift;
260my $pbtag=shift;
261my $pbrev=shift;
262my $pbdate=shift;
263my $pbpackager=shift;
264my $pbproj=shift;
265
266pb_log(2,"DEBUG: From $f to $destfile\n");
267pb_mkdir_p(dirname($destfile)) if (! -d dirname($destfile));
268open(DEST,"> $destfile") || die "Unable to create $destfile";
269open(FILE,"$f") || die "Unable to open $f: $!";
270while (<FILE>) {
271    my $line = $_;
272    foreach my $s (keys %filter) {
273        # Process single variables
274        pb_log(2,"DEBUG filter{$s}: $filter{$s}\n");
275        my $tmp = $filter{$s};
276        next if (not defined $tmp);
277        # Expand variables if any single one found
278        if ($tmp =~ /\$/) {
279            eval { $tmp =~ s/(\$\w+)/$1/eeg };
280        }
281        $line =~ s|$s|$tmp|;
282    }
283    print DEST $line;
284}
285close(FILE);
286close(DEST);
287}
288
289=back
290
291=head1 WEB SITES
292
293The 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/>.
294
295=head1 USER MAILING LIST
296
297None exists for the moment.
298
299=head1 AUTHORS
300
301The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>.
302
303=head1 COPYRIGHT
304
305Project-Builder.org is distributed under the GPL v2.0 license
306described in the file C<COPYING> included with the distribution.
307
308=cut
309
3101;
Note: See TracBrowser for help on using the repository browser.