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

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