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

Last change on this file since 1553 was 1553, checked in by bruno, 7 years ago
  • pb: log when we start and finish the build, that's an important state. Add missing setting of all_ok to false that kept us from properly stopping on errors. Fix typos in comments (coma => comma). Greatly simplify pb_get_distros function by using split and join. Also remove whitespace since multi-line conf file support will cause that to be added. (Eric Anderson)
  • Filter.pm: use new pb_pbos_to_keylist function to generate the list of basenames we want, and use a loop rather than lots of separate statements. Simplifies and makes more powerful this function. Also now guaranteed to maintain consistency with key lookups in the hash maps. (Eric Anderson)
  • rename pb_pbos_to_keylist to pb_distro_to_keylist and make it public (Bruno Cornec)
File size: 8.3 KB
RevLine 
[5]1#!/usr/bin/perl -w
2#
[405]3# ProjectBuilder Filter module
4# Filtering subroutines brought by the the Project-Builder project
5# which can be easily used by pbinit
[5]6#
7# $Id$
8#
9# Copyright B. Cornec 2007
10# Provided under the GPL v2
11
[405]12package ProjectBuilder::Filter;
[9]13
[18]14use strict 'vars';
[9]15use Data::Dumper;
16use English;
[16]17use File::Basename;
[26]18use File::Copy;
[17]19use lib qw (lib);
[1148]20use ProjectBuilder::Version;
[318]21use ProjectBuilder::Base;
[1367]22use ProjectBuilder::Conf;
23use ProjectBuilder::Distribution;
[405]24use ProjectBuilder::Changelog;
[5]25
[405]26# Inherit from the "Exporter" module which handles exporting functions.
27 
[1156]28use vars qw($VERSION $REVISION @ISA @EXPORT);
[405]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);
[1156]36($VERSION,$REVISION) = pb_version_init();
[5]37
[331]38=pod
39
40=head1 NAME
41
[409]42ProjectBuilder::Filter, part of the project-builder.org
[331]43
44=head1 DESCRIPTION
45
[409]46This module provides filtering functions suitable for pbinit calls.
[331]47
[427]48=over 4
49
[409]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.
[1177]57The second parameter is OS hash
[409]58
59The function returns a pointer on a hash of filters.
60
[331]61=cut
62
[395]63sub pb_get_filters {
64
65my @ffiles;
66my $pbpkg = shift || die "No package specified";
[1177]67my $pbos = shift;
[395]68my $ptr = undef; # returned value pointer on the hash of filters
69my %h;
70
[1192]71pb_log(2,"Entering pb_get_filters - pbpkg: $pbpkg - pbos: ".Dumper($pbos)."\n");
[1552]72
73# Global filter files first, then package specific
74my @file_basenames = ('all');
[1553]75@file_basenames = reverse pb_distro_to_keylist($pbos, 'all') if (defined $pbos);
[1552]76# Build list of all filter files
77foreach my $dir ("$ENV{PBROOTDIR}/pbfilter", "$ENV{PBROOTDIR}/$pbpkg/pbfilter") {
78    foreach my $file_basename (@file_basenames) {
79        my $path = "$dir/${file_basename}.pbf";
80        push(@ffiles, $path) if -f $path;
[1177]81    }
[395]82}
83
84if (@ffiles) {
85    pb_log(2,"DEBUG ffiles: ".Dumper(\@ffiles)."\n");
86
87    foreach my $f (@ffiles) {
[1192]88        pb_log(3,"DEBUG processing filter file $f\n");
[395]89        open(CONF,$f) || next;
90        while(<CONF>)  {
91            if (/^\s*([A-z0-9-_]+)\s+([[A-z0-9-_]+)\s*=\s*(.+)$/) {
[1549]92                my ($what, $var, $value) = ($1, $2, $3);
93                pb_log(3,"DEBUG creating entry $what, key $var, value $value\n");
94                # Add support for multi-lines
95                while ($value =~ s/\\\s*$//o) {
96                    $_ = <CONF>;
97                    die "Still processing continuations for $what $var at EOF" if (not defined $_);
98                    s/[\r\n]//go;
99                    $value .= "\n$_";
100                }
101                $h{$what}{$var}=$value;
102            } elsif ((/^\s*#/o) || (/^\s*$/o)) {
103                # ignore
104            } else {
105                chomp();
106                warn "unexpected line '$_' in $f";
[395]107            }
108        }
109        close(CONF);
110    }
[1192]111    $ptr = $h{"filter"};
[1549]112
113    # TODO: find a place to document it. Why not in this file as pod and also documenting filters ?
114    # Handle transform
115    if (defined $h{transform}) {
116        while (my ($out_key,$spec) = each %{$h{transform}}) {
117            die "Unknown transform for $out_key '$spec' expected <out-key> <transform>" unless $spec =~ /^([\w\-]+)\s+(.+)$/;
118            my ($in_key, $expr) = ($1, $2);
119            local $_ = $ptr->{$in_key} || '';
120            eval $expr;
121            die "Error evaluating tranform for $out_key ($expr): $@" if $@;
122            $ptr->{$out_key} = $_;
123            pb_log(2, "Transform $in_key to $out_key\n$ptr->{$in_key}\n$ptr->{$out_key}\n");
124        }
125    }
[395]126}
[1192]127pb_log(2,"DEBUG f:".Dumper($ptr)."\n") if (defined $ptr);
[395]128return($ptr);
129}
130
[499]131=item B<pb_filter_file>
[409]132
[499]133This function applies all filters to files.
[409]134
[499]135It takes 4 parameters.
[409]136
137The first parameter is the file to filter.
[1183]138The second parameter is the pointer on the hash of filters. If undefined no filtering will occur.
[409]139The third parameter is the destination file after filtering.
[499]140The fourth parameter is the pointer on the hash of variables to filter (tag, ver, ...)
[409]141
142=cut
143
[499]144sub pb_filter_file {
[395]145
146my $f=shift;
147my $ptr=shift;
[1183]148my %filter;
149if (defined $ptr) {
150    %filter=%$ptr;
151} else {
152    %filter = ();
153}
[395]154my $destfile=shift;
[499]155my $pb=shift;
[1186]156my $tuple = "unknown";
157$tuple = "$pb->{'pbos'}->{'name'}-$pb->{'pbos'}->{'version'}-$pb->{'pbos'}->{'arch'}" if (defined $pb->{'pbos'});
[395]158
[1186]159pb_log(2,"DEBUG: From $f to $destfile (tuple: $tuple)\n");
160pb_log(3,"DEBUG($tuple): pb ".Dumper($pb)."\n");
[395]161pb_mkdir_p(dirname($destfile)) if (! -d dirname($destfile));
[473]162open(DEST,"> $destfile") || die "Unable to create $destfile: $!";
[395]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);
[500]170        pb_log(3,"DEBUG filter{$s}: $filter{$s}\n");
[395]171        # Expand variables if any single one found
172        if ($tmp =~ /\$/) {
[1044]173            pb_log(3,"*** Filtering variable in $tmp ***\n");
[500]174            # Order is important as we need to handle hashes refs before simple vars
[1252]175            # (?: introduce a Non-capturing groupings cf man perlretut
[1434]176            # We need to avoid handling other VARs (Makefile e.g) so restrict here to $pb type of vars.
[1252]177            eval { $tmp =~ s/(\$\w+(?:-\>\{\'\w+\'\})*)/$1/eeg };
[916]178            if (($s =~ /^PBDESC$/) && ($line =~ /^ PBDESC/)) {
179                # if on debian, we need to preserve the space before each desc line
180                pb_log(3,"*** DEBIAN CASE ADDING SPACE ***\n");
181                $tmp =~ s/\$\//\$\/ /g;
182                pb_log(3,"*** tmp:$tmp ***\n");
183            }
[1434]184            # Support $/ vars
[462]185            eval { $tmp =~ s/(\$\/)/$1/eeg };
[395]186        } elsif (($s =~ /^PBLOG$/) && ($line =~ /^PBLOG$/)) {
[916]187            # special case for ChangeLog only for pb
[500]188            pb_log(3,"DEBUG filtering PBLOG\n");
[585]189            pb_changelog($pb, \*DEST, $tmp);
[395]190            $tmp = "";
[499]191        } elsif (($s =~ /^PBPATCHSRC$/) && ($line =~ /^PBPATCHSRC$/)) {
[1186]192            pb_log(3,"DEBUG($tuple) filtering PBPATCHSRC\n");
[499]193            my $i = 0;
[1186]194            pb_log(3,"DEBUG($tuple): pb ".Dumper($pb)."\n");
195            pb_log(3,"DEBUG($tuple): pb/patches/tuple $pb->{'patches'}->{$tuple}\n");
196            if (defined $pb->{'patches'}->{$tuple}) {
197                foreach my $p (split(/,/,$pb->{'patches'}->{$tuple})) {
198                    pb_log(3,"DEBUG($tuple) Adding patch $i ".basename($p)."\n");
[1180]199                    print DEST "Patch$i:         ".basename($p).".gz\n";
200                    $i++;
201                }
[499]202            }
203            $tmp = "";
[1130]204        } elsif (($s =~ /^PBMULTISRC$/) && ($line =~ /^PBMULTISRC$/)) {
[1186]205            pb_log(3,"DEBUG($tuple) filtering PBMULTISRC\n");
[1130]206            my $i = 1;
[1218]207            if (defined $pb->{'sources'}->{$tuple}) {
[1186]208                foreach my $p (split(/,/,$pb->{'sources'}->{$tuple})) {
209                    pb_log(3,"DEBUG($tuple) Adding source $i ".basename($p)."\n");
[1180]210                    print DEST "Source$i:         ".basename($p)."\n";
211                    $i++;
212                }
[1130]213            }
214            $tmp = "";
[499]215        } elsif (($s =~ /^PBPATCHCMD$/) && ($line =~ /^PBPATCHCMD$/)) {
[1186]216            pb_log(3,"DEBUG($tuple) filtering PBPATCHCMD\n");
[499]217            my $i = 0;
[1186]218            if (defined $pb->{'patches'}->{$tuple}) {
[1367]219                my ($patchcmd,$patchopt) = pb_distro_get_param($pb->{'pbos'},pb_conf_get_if("ospatchcmd","ospatchopt"));
[1186]220                foreach my $p (split(/,/,$pb->{'patches'}->{$tuple})) {
221                    pb_log(3,"DEBUG($tuple) Adding patch command $i\n");
[1367]222                    print DEST "%patch$i $patchopt\n";
[1180]223                    $i++;
224                }
[499]225            }
226            print DEST "\n";
227            $tmp = "";
[395]228        }
[475]229        $line =~ s|$s|$tmp|g;
[395]230    }
231    print DEST $line;
232}
233close(FILE);
234close(DEST);
235}
236
[409]237=item B<pb_filter_file_inplace>
238
239This function applies all filters to a file in place.
240
[499]241It takes 3 parameters.
[409]242
243The first parameter is the pointer on the hash of filters.
244The second parameter is the destination file after filtering.
[499]245The third parameter is the pointer on the hash of variables to filter (tag, ver, ...)
[409]246
247=cut
248
[395]249# Function which applies filter on files (external call)
250sub pb_filter_file_inplace {
251
252my $ptr=shift;
253my $destfile=shift;
[499]254my $pb=shift;
[395]255
[1186]256my $cp = "$ENV{'PBTMP'}/".basename($destfile).".$$";
[500]257copy($destfile,$cp) || die "Unable to copy $destfile to $cp";
[395]258
[499]259pb_filter_file($cp,$ptr,$destfile,$pb);
[395]260unlink $cp;
261}
262
[409]263
264=back
265
266=head1 WEB SITES
267
268The 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/>.
269
270=head1 USER MAILING LIST
271
272None exists for the moment.
273
274=head1 AUTHORS
275
276The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>.
277
278=head1 COPYRIGHT
279
280Project-Builder.org is distributed under the GPL v2.0 license
281described in the file C<COPYING> included with the distribution.
282
283=cut
284
[395]2851;
Note: See TracBrowser for help on using the repository browser.