| 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 |
|
|---|
| 12 | package ProjectBuilder::Filter;
|
|---|
| 13 |
|
|---|
| 14 | use strict 'vars';
|
|---|
| 15 | use Data::Dumper;
|
|---|
| 16 | use English;
|
|---|
| 17 | use File::Basename;
|
|---|
| 18 | use File::Copy;
|
|---|
| 19 | use lib qw (lib);
|
|---|
| 20 | use ProjectBuilder::Version;
|
|---|
| 21 | use ProjectBuilder::Base;
|
|---|
| 22 | use ProjectBuilder::Changelog;
|
|---|
| 23 |
|
|---|
| 24 | # Inherit from the "Exporter" module which handles exporting functions.
|
|---|
| 25 |
|
|---|
| 26 | use vars qw($VERSION $REVISION @ISA @EXPORT);
|
|---|
| 27 | use Exporter;
|
|---|
| 28 |
|
|---|
| 29 | # Export, by default, all the functions into the namespace of
|
|---|
| 30 | # any code which uses this module.
|
|---|
| 31 |
|
|---|
| 32 | our @ISA = qw(Exporter);
|
|---|
| 33 | our @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 |
|
|---|
| 40 | ProjectBuilder::Filter, part of the project-builder.org
|
|---|
| 41 |
|
|---|
| 42 | =head1 DESCRIPTION
|
|---|
| 43 |
|
|---|
| 44 | This module provides filtering functions suitable for pbinit calls.
|
|---|
| 45 |
|
|---|
| 46 | =over 4
|
|---|
| 47 |
|
|---|
| 48 | =item B<pb_get_filters>
|
|---|
| 49 |
|
|---|
| 50 | This function gets all filters to apply. They're cumulative from the less specific to the most specific.
|
|---|
| 51 |
|
|---|
| 52 | Suffix 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 |
|
|---|
| 54 | The first parameter is the package name.
|
|---|
| 55 | The second parameter is OS hash
|
|---|
| 56 |
|
|---|
| 57 | The function returns a pointer on a hash of filters.
|
|---|
| 58 |
|
|---|
| 59 | =cut
|
|---|
| 60 |
|
|---|
| 61 | sub pb_get_filters {
|
|---|
| 62 |
|
|---|
| 63 | my @ffiles;
|
|---|
| 64 | my ($ffile00, $ffile0, $ffile1, $ffile2, $ffile3, $ffile4, $ffile5);
|
|---|
| 65 | my ($mfile00, $mfile0, $mfile1, $mfile2, $mfile3, $mfile4, $mfile5);
|
|---|
| 66 | my $pbpkg = shift || die "No package specified";
|
|---|
| 67 | my $pbos = shift;
|
|---|
| 68 | my $ptr = undef; # returned value pointer on the hash of filters
|
|---|
| 69 | my %h;
|
|---|
| 70 |
|
|---|
| 71 | pb_log(2,"Entering pb_get_filters - pbpkg: $pbpkg - pbos: ".Dumper($pbos)."\n");
|
|---|
| 72 | # Global filter files first, then package specificities
|
|---|
| 73 | if (-d "$ENV{'PBROOTDIR'}/pbfilter") {
|
|---|
| 74 | $mfile00 = "$ENV{'PBROOTDIR'}/pbfilter/all.pbf" if (-f "$ENV{'PBROOTDIR'}/pbfilter/all.pbf");
|
|---|
| 75 | if (defined $pbos) {
|
|---|
| 76 | $mfile0 = "$ENV{'PBROOTDIR'}/pbfilter/$pbos->{'os'}.pbf" if ((defined $pbos->{'os'}) && (-f "$ENV{'PBROOTDIR'}/pbfilter/$pbos->{'os'}.pbf"));
|
|---|
| 77 | $mfile1 = "$ENV{'PBROOTDIR'}/pbfilter/$pbos->{'type'}.pbf" if ((defined $pbos->{'type'}) && (-f "$ENV{'PBROOTDIR'}/pbfilter/$pbos->{'type'}.pbf"));
|
|---|
| 78 | $mfile2 = "$ENV{'PBROOTDIR'}/pbfilter/$pbos->{'family'}.pbf" if ((defined $pbos->{'family'}) && (-f "$ENV{'PBROOTDIR'}/pbfilter/$pbos->{'family'}.pbf"));
|
|---|
| 79 | $mfile3 = "$ENV{'PBROOTDIR'}/pbfilter/$pbos->{'name'}.pbf" if ((defined $pbos->{'name'}) && (-f "$ENV{'PBROOTDIR'}/pbfilter/$pbos->{'name'}.pbf"));
|
|---|
| 80 | $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"));
|
|---|
| 81 | $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"));
|
|---|
| 82 | }
|
|---|
| 83 |
|
|---|
| 84 | push @ffiles,$mfile00 if (defined $mfile00);
|
|---|
| 85 | push @ffiles,$mfile0 if (defined $mfile0);
|
|---|
| 86 | push @ffiles,$mfile1 if (defined $mfile1);
|
|---|
| 87 | push @ffiles,$mfile2 if (defined $mfile2);
|
|---|
| 88 | push @ffiles,$mfile3 if (defined $mfile3);
|
|---|
| 89 | push @ffiles,$mfile4 if (defined $mfile4);
|
|---|
| 90 | push @ffiles,$mfile5 if (defined $mfile5);
|
|---|
| 91 | }
|
|---|
| 92 |
|
|---|
| 93 | if (-d "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter") {
|
|---|
| 94 | $ffile00 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/all.pbf" if (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/all.pbf");
|
|---|
| 95 | if (defined $pbos) {
|
|---|
| 96 | $ffile0 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$pbos->{'os'}.pbf" if ((defined $pbos->{'os'}) && (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$pbos->{'os'}.pbf"));
|
|---|
| 97 | $ffile1 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$pbos->{'type'}.pbf" if ((defined $pbos->{'type'}) && (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$pbos->{'type'}.pbf"));
|
|---|
| 98 | $ffile2 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$pbos->{'family'}.pbf" if ((defined $pbos->{'family'}) && (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$pbos->{'family'}.pbf"));
|
|---|
| 99 | $ffile3 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$pbos->{'name'}.pbf" if ((defined $pbos->{'name'}) && (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$pbos->{'name'}.pbf"));
|
|---|
| 100 | $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"));
|
|---|
| 101 | $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"));
|
|---|
| 102 | }
|
|---|
| 103 | push @ffiles,$ffile00 if (defined $ffile00);
|
|---|
| 104 | push @ffiles,$ffile0 if (defined $ffile0);
|
|---|
| 105 | push @ffiles,$ffile1 if (defined $ffile1);
|
|---|
| 106 | push @ffiles,$ffile2 if (defined $ffile2);
|
|---|
| 107 | push @ffiles,$ffile3 if (defined $ffile3);
|
|---|
| 108 | push @ffiles,$ffile4 if (defined $ffile4);
|
|---|
| 109 | push @ffiles,$ffile5 if (defined $ffile5);
|
|---|
| 110 | }
|
|---|
| 111 | if (@ffiles) {
|
|---|
| 112 | pb_log(2,"DEBUG ffiles: ".Dumper(\@ffiles)."\n");
|
|---|
| 113 |
|
|---|
| 114 | foreach my $f (@ffiles) {
|
|---|
| 115 | pb_log(3,"DEBUG processing filter file $f\n");
|
|---|
| 116 | open(CONF,$f) || next;
|
|---|
| 117 | while(<CONF>) {
|
|---|
| 118 | if (/^\s*([A-z0-9-_]+)\s+([[A-z0-9-_]+)\s*=\s*(.+)$/) {
|
|---|
| 119 | pb_log(3,"DEBUG creating entry $1, key $2, value $3\n");
|
|---|
| 120 | $h{$1}{$2}=$3;
|
|---|
| 121 | }
|
|---|
| 122 | }
|
|---|
| 123 | close(CONF);
|
|---|
| 124 | }
|
|---|
| 125 | $ptr = $h{"filter"};
|
|---|
| 126 | }
|
|---|
| 127 | pb_log(2,"DEBUG f:".Dumper($ptr)."\n") if (defined $ptr);
|
|---|
| 128 | return($ptr);
|
|---|
| 129 | }
|
|---|
| 130 |
|
|---|
| 131 | =item B<pb_filter_file>
|
|---|
| 132 |
|
|---|
| 133 | This function applies all filters to files.
|
|---|
| 134 |
|
|---|
| 135 | It takes 4 parameters.
|
|---|
| 136 |
|
|---|
| 137 | The first parameter is the file to filter.
|
|---|
| 138 | The second parameter is the pointer on the hash of filters. If undefined no filtering will occur.
|
|---|
| 139 | The third parameter is the destination file after filtering.
|
|---|
| 140 | The fourth parameter is the pointer on the hash of variables to filter (tag, ver, ...)
|
|---|
| 141 |
|
|---|
| 142 | =cut
|
|---|
| 143 |
|
|---|
| 144 | sub pb_filter_file {
|
|---|
| 145 |
|
|---|
| 146 | my $f=shift;
|
|---|
| 147 | my $ptr=shift;
|
|---|
| 148 | my %filter;
|
|---|
| 149 | if (defined $ptr) {
|
|---|
| 150 | %filter=%$ptr;
|
|---|
| 151 | } else {
|
|---|
| 152 | %filter = ();
|
|---|
| 153 | }
|
|---|
| 154 | my $destfile=shift;
|
|---|
| 155 | my $pb=shift;
|
|---|
| 156 | my $tuple = "unknown";
|
|---|
| 157 | $tuple = "$pb->{'pbos'}->{'name'}-$pb->{'pbos'}->{'version'}-$pb->{'pbos'}->{'arch'}" if (defined $pb->{'pbos'});
|
|---|
| 158 |
|
|---|
| 159 | pb_log(2,"DEBUG: From $f to $destfile (tuple: $tuple)\n");
|
|---|
| 160 | pb_log(3,"DEBUG($tuple): pb ".Dumper($pb)."\n");
|
|---|
| 161 | pb_mkdir_p(dirname($destfile)) if (! -d dirname($destfile));
|
|---|
| 162 | open(DEST,"> $destfile") || die "Unable to create $destfile: $!";
|
|---|
| 163 | open(FILE,"$f") || die "Unable to open $f: $!";
|
|---|
| 164 | while (<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);
|
|---|
| 170 | pb_log(3,"DEBUG filter{$s}: $filter{$s}\n");
|
|---|
| 171 | # Expand variables if any single one found
|
|---|
| 172 | if ($tmp =~ /\$/) {
|
|---|
| 173 | pb_log(3,"*** Filtering variable in $tmp ***\n");
|
|---|
| 174 | # Order is important as we need to handle hashes refs before simple vars
|
|---|
| 175 | # (?: introduce a Non-capturing groupings cf man perlretut
|
|---|
| 176 | eval { $tmp =~ s/(\$\w+(?:-\>\{\'\w+\'\})*)/$1/eeg };
|
|---|
| 177 | if (($s =~ /^PBDESC$/) && ($line =~ /^ PBDESC/)) {
|
|---|
| 178 | # if on debian, we need to preserve the space before each desc line
|
|---|
| 179 | pb_log(3,"*** DEBIAN CASE ADDING SPACE ***\n");
|
|---|
| 180 | $tmp =~ s/\$\//\$\/ /g;
|
|---|
| 181 | pb_log(3,"*** tmp:$tmp ***\n");
|
|---|
| 182 | }
|
|---|
| 183 | eval { $tmp =~ s/(\$\/)/$1/eeg };
|
|---|
| 184 | } elsif (($s =~ /^PBLOG$/) && ($line =~ /^PBLOG$/)) {
|
|---|
| 185 | # special case for ChangeLog only for pb
|
|---|
| 186 | pb_log(3,"DEBUG filtering PBLOG\n");
|
|---|
| 187 | pb_changelog($pb, \*DEST, $tmp);
|
|---|
| 188 | $tmp = "";
|
|---|
| 189 | } elsif (($s =~ /^PBPATCHSRC$/) && ($line =~ /^PBPATCHSRC$/)) {
|
|---|
| 190 | pb_log(3,"DEBUG($tuple) filtering PBPATCHSRC\n");
|
|---|
| 191 | my $i = 0;
|
|---|
| 192 | pb_log(3,"DEBUG($tuple): pb ".Dumper($pb)."\n");
|
|---|
| 193 | pb_log(3,"DEBUG($tuple): pb/patches/tuple $pb->{'patches'}->{$tuple}\n");
|
|---|
| 194 | if (defined $pb->{'patches'}->{$tuple}) {
|
|---|
| 195 | foreach my $p (split(/,/,$pb->{'patches'}->{$tuple})) {
|
|---|
| 196 | pb_log(3,"DEBUG($tuple) Adding patch $i ".basename($p)."\n");
|
|---|
| 197 | print DEST "Patch$i: ".basename($p).".gz\n";
|
|---|
| 198 | $i++;
|
|---|
| 199 | }
|
|---|
| 200 | }
|
|---|
| 201 | $tmp = "";
|
|---|
| 202 | } elsif (($s =~ /^PBMULTISRC$/) && ($line =~ /^PBMULTISRC$/)) {
|
|---|
| 203 | pb_log(3,"DEBUG($tuple) filtering PBMULTISRC\n");
|
|---|
| 204 | my $i = 1;
|
|---|
| 205 | if (defined $pb->{'sources'}->{$tuple}) {
|
|---|
| 206 | foreach my $p (split(/,/,$pb->{'sources'}->{$tuple})) {
|
|---|
| 207 | pb_log(3,"DEBUG($tuple) Adding source $i ".basename($p)."\n");
|
|---|
| 208 | print DEST "Source$i: ".basename($p)."\n";
|
|---|
| 209 | $i++;
|
|---|
| 210 | }
|
|---|
| 211 | }
|
|---|
| 212 | $tmp = "";
|
|---|
| 213 | } elsif (($s =~ /^PBPATCHCMD$/) && ($line =~ /^PBPATCHCMD$/)) {
|
|---|
| 214 | pb_log(3,"DEBUG($tuple) filtering PBPATCHCMD\n");
|
|---|
| 215 | my $i = 0;
|
|---|
| 216 | if (defined $pb->{'patches'}->{$tuple}) {
|
|---|
| 217 | foreach my $p (split(/,/,$pb->{'patches'}->{$tuple})) {
|
|---|
| 218 | pb_log(3,"DEBUG($tuple) Adding patch command $i\n");
|
|---|
| 219 | print DEST "%patch$i -p1\n";
|
|---|
| 220 | $i++;
|
|---|
| 221 | }
|
|---|
| 222 | }
|
|---|
| 223 | print DEST "\n";
|
|---|
| 224 | $tmp = "";
|
|---|
| 225 | }
|
|---|
| 226 | $line =~ s|$s|$tmp|g;
|
|---|
| 227 | }
|
|---|
| 228 | print DEST $line;
|
|---|
| 229 | }
|
|---|
| 230 | close(FILE);
|
|---|
| 231 | close(DEST);
|
|---|
| 232 | }
|
|---|
| 233 |
|
|---|
| 234 | =item B<pb_filter_file_inplace>
|
|---|
| 235 |
|
|---|
| 236 | This function applies all filters to a file in place.
|
|---|
| 237 |
|
|---|
| 238 | It takes 3 parameters.
|
|---|
| 239 |
|
|---|
| 240 | The first parameter is the pointer on the hash of filters.
|
|---|
| 241 | The second parameter is the destination file after filtering.
|
|---|
| 242 | The third parameter is the pointer on the hash of variables to filter (tag, ver, ...)
|
|---|
| 243 |
|
|---|
| 244 | =cut
|
|---|
| 245 |
|
|---|
| 246 | # Function which applies filter on files (external call)
|
|---|
| 247 | sub pb_filter_file_inplace {
|
|---|
| 248 |
|
|---|
| 249 | my $ptr=shift;
|
|---|
| 250 | my $destfile=shift;
|
|---|
| 251 | my $pb=shift;
|
|---|
| 252 |
|
|---|
| 253 | my $cp = "$ENV{'PBTMP'}/".basename($destfile).".$$";
|
|---|
| 254 | copy($destfile,$cp) || die "Unable to copy $destfile to $cp";
|
|---|
| 255 |
|
|---|
| 256 | pb_filter_file($cp,$ptr,$destfile,$pb);
|
|---|
| 257 | unlink $cp;
|
|---|
| 258 | }
|
|---|
| 259 |
|
|---|
| 260 |
|
|---|
| 261 | =back
|
|---|
| 262 |
|
|---|
| 263 | =head1 WEB SITES
|
|---|
| 264 |
|
|---|
| 265 | The 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/>.
|
|---|
| 266 |
|
|---|
| 267 | =head1 USER MAILING LIST
|
|---|
| 268 |
|
|---|
| 269 | None exists for the moment.
|
|---|
| 270 |
|
|---|
| 271 | =head1 AUTHORS
|
|---|
| 272 |
|
|---|
| 273 | The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>.
|
|---|
| 274 |
|
|---|
| 275 | =head1 COPYRIGHT
|
|---|
| 276 |
|
|---|
| 277 | Project-Builder.org is distributed under the GPL v2.0 license
|
|---|
| 278 | described in the file C<COPYING> included with the distribution.
|
|---|
| 279 |
|
|---|
| 280 | =cut
|
|---|
| 281 |
|
|---|
| 282 | 1;
|
|---|
