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

Last change on this file since 1186 was 1186, checked in by bruno, 8 years ago
  • Fix now pateches and sources delivery in parallel mode completely.
File size: 8.7 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);
65my ($mfile00, $mfile0, $mfile1, $mfile2, $mfile3);
66my $pbpkg = shift || die "No package specified";
67my $pbos = shift;
68my $ptr = undef; # returned value pointer on the hash of filters
69my %h;
70
71# Global filter files first, then package specificities
72if (-d "$ENV{'PBROOTDIR'}/pbfilter") {
73    $mfile00 = "$ENV{'PBROOTDIR'}/pbfilter/all.pbf" if (-f "$ENV{'PBROOTDIR'}/pbfilter/all.pbf");
74    if (defined $pbos) {
75        $mfile0 = "$ENV{'PBROOTDIR'}/pbfilter/$pbos->{'type'}.pbf" if ((defined $pbos->{'type'}) && (-f "$ENV{'PBROOTDIR'}/pbfilter/$pbos->{'type'}.pbf"));
76        $mfile1 = "$ENV{'PBROOTDIR'}/pbfilter/$pbos->{'family'}.pbf" if ((defined $pbos->{'type'}) && (-f "$ENV{'PBROOTDIR'}/pbfilter/$pbos->{'family'}.pbf"));
77        $mfile2 = "$ENV{'PBROOTDIR'}/pbfilter/$pbos->{'name'}.pbf" if ((defined $pbos->{'type'}) && (-f "$ENV{'PBROOTDIR'}/pbfilter/$pbos->{'name'}.pbf"));
78        $mfile3 = "$ENV{'PBROOTDIR'}/pbfilter/$pbos->{'name'}-$pbos->{'version'}.pbf" if ((defined $pbos->{'type'}) && (-f "$ENV{'PBROOTDIR'}/pbfilter/$pbos->{'name'}-$pbos->{'version'}.pbf"));
79    }
80
81    push @ffiles,$mfile00 if (defined $mfile00);
82    push @ffiles,$mfile0 if (defined $mfile0);
83    push @ffiles,$mfile1 if (defined $mfile1);
84    push @ffiles,$mfile2 if (defined $mfile2);
85    push @ffiles,$mfile3 if (defined $mfile3);
86}
87
88if (-d "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter") {
89    $ffile00 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/all.pbf" if (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/all.pbf");
90    if (defined $pbos) {
91        $ffile0 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$pbos->{'type'}.pbf" if ((defined $pbos->{'type'}) && (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$pbos->{'type'}.pbf"));
92        $ffile1 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$pbos->{'family'}.pbf" if ((defined $pbos->{'type'}) && (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$pbos->{'family'}.pbf"));
93        $ffile2 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$pbos->{'name'}.pbf" if ((defined $pbos->{'type'}) && (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$pbos->{'name'}.pbf"));
94        $ffile3 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$pbos->{'name'}-$pbos->{'version'}.pbf" if ((defined $pbos->{'type'}) && (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$pbos->{'name'}-$pbos->{'version'}.pbf"));
95    }
96    push @ffiles,$ffile00 if (defined $ffile00);
97    push @ffiles,$ffile0 if (defined $ffile0);
98    push @ffiles,$ffile1 if (defined $ffile1);
99    push @ffiles,$ffile2 if (defined $ffile2);
100    push @ffiles,$ffile3 if (defined $ffile3);
101}
102if (@ffiles) {
103    pb_log(2,"DEBUG ffiles: ".Dumper(\@ffiles)."\n");
104
105    foreach my $f (@ffiles) {
106        open(CONF,$f) || next;
107        while(<CONF>)  {
108            if (/^\s*([A-z0-9-_]+)\s+([[A-z0-9-_]+)\s*=\s*(.+)$/) {
109                $h{$1}{$2}=$3;
110            }
111        }
112        close(CONF);
113
114        $ptr = $h{"filter"};
115        pb_log(2,"DEBUG f:".Dumper($ptr)."\n");
116    }
117}
118return($ptr);
119}
120
121=item B<pb_filter_file>
122
123This function applies all filters to files.
124
125It takes 4 parameters.
126
127The first parameter is the file to filter.
128The second parameter is the pointer on the hash of filters. If undefined no filtering will occur.
129The third parameter is the destination file after filtering.
130The fourth parameter is the pointer on the hash of variables to filter (tag, ver, ...)
131
132=cut
133
134sub pb_filter_file {
135
136my $f=shift;
137my $ptr=shift;
138my %filter;
139if (defined $ptr) {
140    %filter=%$ptr;
141} else {
142    %filter = ();
143}
144my $destfile=shift;
145my $pb=shift;
146my $tuple = "unknown";
147$tuple = "$pb->{'pbos'}->{'name'}-$pb->{'pbos'}->{'version'}-$pb->{'pbos'}->{'arch'}" if (defined $pb->{'pbos'});
148
149pb_log(2,"DEBUG: From $f to $destfile (tuple: $tuple)\n");
150pb_log(3,"DEBUG($tuple): pb ".Dumper($pb)."\n");
151pb_mkdir_p(dirname($destfile)) if (! -d dirname($destfile));
152open(DEST,"> $destfile") || die "Unable to create $destfile: $!";
153open(FILE,"$f") || die "Unable to open $f: $!";
154while (<FILE>) {
155    my $line = $_;
156    foreach my $s (keys %filter) {
157        # Process single variables
158        my $tmp = $filter{$s};
159        next if (not defined $tmp);
160        pb_log(3,"DEBUG filter{$s}: $filter{$s}\n");
161        # Expand variables if any single one found
162        if ($tmp =~ /\$/) {
163            pb_log(3,"*** Filtering variable in $tmp ***\n");
164            # Order is important as we need to handle hashes refs before simple vars
165            eval { $tmp =~ s/(\$\w+-\>\{\'\w+\'\})/$1/eeg };
166            eval { $tmp =~ s/(\$\w+)/$1/eeg };
167            if (($s =~ /^PBDESC$/) && ($line =~ /^ PBDESC/)) {
168                # if on debian, we need to preserve the space before each desc line
169                pb_log(3,"*** DEBIAN CASE ADDING SPACE ***\n");
170                $tmp =~ s/\$\//\$\/ /g;
171                pb_log(3,"*** tmp:$tmp ***\n");
172            }
173            eval { $tmp =~ s/(\$\/)/$1/eeg };
174        } elsif (($s =~ /^PBLOG$/) && ($line =~ /^PBLOG$/)) {
175            # special case for ChangeLog only for pb
176            pb_log(3,"DEBUG filtering PBLOG\n");
177            pb_changelog($pb, \*DEST, $tmp);
178            $tmp = "";
179        } elsif (($s =~ /^PBPATCHSRC$/) && ($line =~ /^PBPATCHSRC$/)) {
180            pb_log(3,"DEBUG($tuple) filtering PBPATCHSRC\n");
181            my $i = 0;
182            pb_log(3,"DEBUG($tuple): pb ".Dumper($pb)."\n");
183            pb_log(3,"DEBUG($tuple): pb/patches/tuple $pb->{'patches'}->{$tuple}\n");
184            if (defined $pb->{'patches'}->{$tuple}) {
185                foreach my $p (split(/,/,$pb->{'patches'}->{$tuple})) {
186                    pb_log(3,"DEBUG($tuple) Adding patch $i ".basename($p)."\n");
187                    print DEST "Patch$i:         ".basename($p).".gz\n";
188                    $i++;
189                }
190            }
191            $tmp = "";
192        } elsif (($s =~ /^PBMULTISRC$/) && ($line =~ /^PBMULTISRC$/)) {
193            pb_log(3,"DEBUG($tuple) filtering PBMULTISRC\n");
194            my $i = 1;
195            if (defined $pb->{'patches'}->{$tuple}) {
196                foreach my $p (split(/,/,$pb->{'sources'}->{$tuple})) {
197                    pb_log(3,"DEBUG($tuple) Adding source $i ".basename($p)."\n");
198                    print DEST "Source$i:         ".basename($p)."\n";
199                    $i++;
200                }
201            }
202            $tmp = "";
203        } elsif (($s =~ /^PBPATCHCMD$/) && ($line =~ /^PBPATCHCMD$/)) {
204            pb_log(3,"DEBUG($tuple) filtering PBPATCHCMD\n");
205            my $i = 0;
206            if (defined $pb->{'patches'}->{$tuple}) {
207                foreach my $p (split(/,/,$pb->{'patches'}->{$tuple})) {
208                    pb_log(3,"DEBUG($tuple) Adding patch command $i\n");
209                    print DEST "%patch$i -p1\n";
210                    $i++;
211                }
212            }
213            print DEST "\n";
214            $tmp = "";
215        }
216        $line =~ s|$s|$tmp|g;
217    }
218    print DEST $line;
219}
220close(FILE);
221close(DEST);
222}
223
224=item B<pb_filter_file_inplace>
225
226This function applies all filters to a file in place.
227
228It takes 3 parameters.
229
230The first parameter is the pointer on the hash of filters.
231The second parameter is the destination file after filtering.
232The third parameter is the pointer on the hash of variables to filter (tag, ver, ...)
233
234=cut
235
236# Function which applies filter on files (external call)
237sub pb_filter_file_inplace {
238
239my $ptr=shift;
240my $destfile=shift;
241my $pb=shift;
242
243my $cp = "$ENV{'PBTMP'}/".basename($destfile).".$$";
244copy($destfile,$cp) || die "Unable to copy $destfile to $cp";
245
246pb_filter_file($cp,$ptr,$destfile,$pb);
247unlink $cp;
248}
249
250
251=back
252
253=head1 WEB SITES
254
255The 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/>.
256
257=head1 USER MAILING LIST
258
259None exists for the moment.
260
261=head1 AUTHORS
262
263The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>.
264
265=head1 COPYRIGHT
266
267Project-Builder.org is distributed under the GPL v2.0 license
268described in the file C<COPYING> included with the distribution.
269
270=cut
271
2721;
Note: See TracBrowser for help on using the repository browser.