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

Last change on this file since 1549 was 1549, checked in by bruno, 7 years ago
  • pb: Improve build2pkg documentation so It can be referenced in build2ve. Document need to specify verpmtype for a rpm-style VE. Add substep of further fixes to filters and build files in build2ve. Provide example of needing an additional repo, which is more likely on centos. Fix bug with adapting owner since centos5.8 sets up so that we can't sudo until the sudoers file is fixed, but we don't do so until later. However, if we call su, then we need to keep the additional sudo. Apply the ftp/http proxy bits from the config file while setting up a VE. Don't try to mount /proc if it is already mounted. Fiddle with the substitution on requiretty; it wasn't working so moved to \s+ instead of [ \t]+ also left a comment to show users that the line was removed. Remove comment about applying ftp/http proxy to bootstrapping since we now do. Add note that we probably want a variable for where to get the source snapshot for source "installs" of project-builder.
  • Filter.pm: Add support for multi-line filter variables since a description in an rpm or deb file is usually multiple lines long (this is now in addition to the support of the $/ variable). Add support for transforming those things since debian files use leading spaces, and rpm files don't. Transforms let you start with the same variable and fix it for the different OSs. Leave note about unknown "correct" documentation location.
File size: 11.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                my ($what, $var, $value) = ($1, $2, $3);
122                pb_log(3,"DEBUG creating entry $what, key $var, value $value\n");
123                # Add support for multi-lines
124                while ($value =~ s/\\\s*$//o) {
125                    $_ = <CONF>;
126                    die "Still processing continuations for $what $var at EOF" if (not defined $_);
127                    s/[\r\n]//go;
128                    $value .= "\n$_";
129                }
130                $h{$what}{$var}=$value;
131            } elsif ((/^\s*#/o) || (/^\s*$/o)) {
132                # ignore
133            } else {
134                chomp();
135                warn "unexpected line '$_' in $f";
136            }
137        }
138        close(CONF);
139    }
140    $ptr = $h{"filter"};
141
142    # TODO: find a place to document it. Why not in this file as pod and also documenting filters ?
143    # Handle transform
144    if (defined $h{transform}) {
145        while (my ($out_key,$spec) = each %{$h{transform}}) {
146            die "Unknown transform for $out_key '$spec' expected <out-key> <transform>" unless $spec =~ /^([\w\-]+)\s+(.+)$/;
147            my ($in_key, $expr) = ($1, $2);
148            local $_ = $ptr->{$in_key} || '';
149            eval $expr;
150            die "Error evaluating tranform for $out_key ($expr): $@" if $@;
151            $ptr->{$out_key} = $_;
152            pb_log(2, "Transform $in_key to $out_key\n$ptr->{$in_key}\n$ptr->{$out_key}\n");
153        }
154    }
155}
156pb_log(2,"DEBUG f:".Dumper($ptr)."\n") if (defined $ptr);
157return($ptr);
158}
159
160=item B<pb_filter_file>
161
162This function applies all filters to files.
163
164It takes 4 parameters.
165
166The first parameter is the file to filter.
167The second parameter is the pointer on the hash of filters. If undefined no filtering will occur.
168The third parameter is the destination file after filtering.
169The fourth parameter is the pointer on the hash of variables to filter (tag, ver, ...)
170
171=cut
172
173sub pb_filter_file {
174
175my $f=shift;
176my $ptr=shift;
177my %filter;
178if (defined $ptr) {
179    %filter=%$ptr;
180} else {
181    %filter = ();
182}
183my $destfile=shift;
184my $pb=shift;
185my $tuple = "unknown";
186$tuple = "$pb->{'pbos'}->{'name'}-$pb->{'pbos'}->{'version'}-$pb->{'pbos'}->{'arch'}" if (defined $pb->{'pbos'});
187
188pb_log(2,"DEBUG: From $f to $destfile (tuple: $tuple)\n");
189pb_log(3,"DEBUG($tuple): pb ".Dumper($pb)."\n");
190pb_mkdir_p(dirname($destfile)) if (! -d dirname($destfile));
191open(DEST,"> $destfile") || die "Unable to create $destfile: $!";
192open(FILE,"$f") || die "Unable to open $f: $!";
193while (<FILE>) {
194    my $line = $_;
195    foreach my $s (keys %filter) {
196        # Process single variables
197        my $tmp = $filter{$s};
198        next if (not defined $tmp);
199        pb_log(3,"DEBUG filter{$s}: $filter{$s}\n");
200        # Expand variables if any single one found
201        if ($tmp =~ /\$/) {
202            pb_log(3,"*** Filtering variable in $tmp ***\n");
203            # Order is important as we need to handle hashes refs before simple vars
204            # (?: introduce a Non-capturing groupings cf man perlretut
205            # We need to avoid handling other VARs (Makefile e.g) so restrict here to $pb type of vars.
206            eval { $tmp =~ s/(\$\w+(?:-\>\{\'\w+\'\})*)/$1/eeg };
207            if (($s =~ /^PBDESC$/) && ($line =~ /^ PBDESC/)) {
208                # if on debian, we need to preserve the space before each desc line
209                pb_log(3,"*** DEBIAN CASE ADDING SPACE ***\n");
210                $tmp =~ s/\$\//\$\/ /g;
211                pb_log(3,"*** tmp:$tmp ***\n");
212            }
213            # Support $/ vars
214            eval { $tmp =~ s/(\$\/)/$1/eeg };
215        } elsif (($s =~ /^PBLOG$/) && ($line =~ /^PBLOG$/)) {
216            # special case for ChangeLog only for pb
217            pb_log(3,"DEBUG filtering PBLOG\n");
218            pb_changelog($pb, \*DEST, $tmp);
219            $tmp = "";
220        } elsif (($s =~ /^PBPATCHSRC$/) && ($line =~ /^PBPATCHSRC$/)) {
221            pb_log(3,"DEBUG($tuple) filtering PBPATCHSRC\n");
222            my $i = 0;
223            pb_log(3,"DEBUG($tuple): pb ".Dumper($pb)."\n");
224            pb_log(3,"DEBUG($tuple): pb/patches/tuple $pb->{'patches'}->{$tuple}\n");
225            if (defined $pb->{'patches'}->{$tuple}) {
226                foreach my $p (split(/,/,$pb->{'patches'}->{$tuple})) {
227                    pb_log(3,"DEBUG($tuple) Adding patch $i ".basename($p)."\n");
228                    print DEST "Patch$i:         ".basename($p).".gz\n";
229                    $i++;
230                }
231            }
232            $tmp = "";
233        } elsif (($s =~ /^PBMULTISRC$/) && ($line =~ /^PBMULTISRC$/)) {
234            pb_log(3,"DEBUG($tuple) filtering PBMULTISRC\n");
235            my $i = 1;
236            if (defined $pb->{'sources'}->{$tuple}) {
237                foreach my $p (split(/,/,$pb->{'sources'}->{$tuple})) {
238                    pb_log(3,"DEBUG($tuple) Adding source $i ".basename($p)."\n");
239                    print DEST "Source$i:         ".basename($p)."\n";
240                    $i++;
241                }
242            }
243            $tmp = "";
244        } elsif (($s =~ /^PBPATCHCMD$/) && ($line =~ /^PBPATCHCMD$/)) {
245            pb_log(3,"DEBUG($tuple) filtering PBPATCHCMD\n");
246            my $i = 0;
247            if (defined $pb->{'patches'}->{$tuple}) {
248                my ($patchcmd,$patchopt) = pb_distro_get_param($pb->{'pbos'},pb_conf_get_if("ospatchcmd","ospatchopt"));
249                foreach my $p (split(/,/,$pb->{'patches'}->{$tuple})) {
250                    pb_log(3,"DEBUG($tuple) Adding patch command $i\n");
251                    print DEST "%patch$i $patchopt\n";
252                    $i++;
253                }
254            }
255            print DEST "\n";
256            $tmp = "";
257        }
258        $line =~ s|$s|$tmp|g;
259    }
260    print DEST $line;
261}
262close(FILE);
263close(DEST);
264}
265
266=item B<pb_filter_file_inplace>
267
268This function applies all filters to a file in place.
269
270It takes 3 parameters.
271
272The first parameter is the pointer on the hash of filters.
273The second parameter is the destination file after filtering.
274The third parameter is the pointer on the hash of variables to filter (tag, ver, ...)
275
276=cut
277
278# Function which applies filter on files (external call)
279sub pb_filter_file_inplace {
280
281my $ptr=shift;
282my $destfile=shift;
283my $pb=shift;
284
285my $cp = "$ENV{'PBTMP'}/".basename($destfile).".$$";
286copy($destfile,$cp) || die "Unable to copy $destfile to $cp";
287
288pb_filter_file($cp,$ptr,$destfile,$pb);
289unlink $cp;
290}
291
292
293=back
294
295=head1 WEB SITES
296
297The 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/>.
298
299=head1 USER MAILING LIST
300
301None exists for the moment.
302
303=head1 AUTHORS
304
305The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>.
306
307=head1 COPYRIGHT
308
309Project-Builder.org is distributed under the GPL v2.0 license
310described in the file C<COPYING> included with the distribution.
311
312=cut
313
3141;
Note: See TracBrowser for help on using the repository browser.