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

#!/usr/bin/perl -w
#
# ProjectBuilder Filter module
# Filtering subroutines brought by the the Project-Builder project
# which can be easily used by pbinit
#
# $Id$
#
# Copyright B. Cornec 2007
# Provided under the GPL v2

package ProjectBuilder::Filter;

use strict 'vars';
use Data::Dumper;
use English;
use File::Basename;
use File::Copy;
use lib qw (lib);
use ProjectBuilder::Base;
use ProjectBuilder::Changelog;

# Inherit from the "Exporter" module which handles exporting functions.
 
use Exporter;
 
# Export, by default, all the functions into the namespace of
# any code which uses this module.
 
our @ISA = qw(Exporter);
our @EXPORT = qw(pb_get_filters pb_filter_file_pb pb_filter_file_inplace pb_filter_file);

=pod

=head1 NAME

ProjectBuilder::Base, part of the project-builder.org - module dealing with generic functions suitable for perl project development

=head1 DESCRIPTION

pb helps you build various packages directly from your project sources. 
Those sources could be handled by a CMS (Configuration Management System)
such as Subversion, CVS, ... or being a simple reference to a compressed tar file.
It's based on a set of configuration files, a set of provided macros to help 
you keeping build files as generic as possible. For example, a single .spec
file should be required to generate for all rpm based distributions, even 
if you could also have multiple .spec files if required.

=cut

# Get all filters to apply
# They're cumulative from less specific to most specific
# suffix is .pbf

sub pb_get_filters {

my @ffiles;
my ($ffile00, $ffile0, $ffile1, $ffile2, $ffile3);
my ($mfile00, $mfile0, $mfile1, $mfile2, $mfile3);
my $pbpkg = shift || die "No package specified";
my $dtype = shift || "";
my $dfam = shift || "";
my $ddir = shift || "";
my $dver = shift || "";
my $ptr = undef; # returned value pointer on the hash of filters
my %h;

# Global filter files first, then package specificities
if (-d "$ENV{'PBROOTDIR'}/pbfilter") {
    $mfile00 = "$ENV{'PBROOTDIR'}/pbfilter/all.pbf" if (-f "$ENV{'PBROOTDIR'}/pbfilter/all.pbf");
    $mfile0 = "$ENV{'PBROOTDIR'}/pbfilter/$dtype.pbf" if (-f "$ENV{'PBROOTDIR'}/pbfilter/$dtype.pbf");
    $mfile1 = "$ENV{'PBROOTDIR'}/pbfilter/$dfam.pbf" if (-f "$ENV{'PBROOTDIR'}/pbfilter/$dfam.pbf");
    $mfile2 = "$ENV{'PBROOTDIR'}/pbfilter/$ddir.pbf" if (-f "$ENV{'PBROOTDIR'}/pbfilter/$ddir.pbf");
    $mfile3 = "$ENV{'PBROOTDIR'}/pbfilter/$ddir-$dver.pbf" if (-f "$ENV{'PBROOTDIR'}/pbfilter/$ddir-$dver.pbf");

    push @ffiles,$mfile00 if (defined $mfile00);
    push @ffiles,$mfile0 if (defined $mfile0);
    push @ffiles,$mfile1 if (defined $mfile1);
    push @ffiles,$mfile2 if (defined $mfile2);
    push @ffiles,$mfile3 if (defined $mfile3);
}

if (-d "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter") {
    $ffile00 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/all.pbf" if (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/all.pbf");
    $ffile0 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$dtype.pbf" if (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$dtype.pbf");
    $ffile1 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$dfam.pbf" if (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$dfam.pbf");
    $ffile2 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$ddir.pbf" if (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$ddir.pbf");
    $ffile3 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$ddir-$dver.pbf" if (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$ddir-$dver.pbf");

    push @ffiles,$ffile00 if (defined $ffile00);
    push @ffiles,$ffile0 if (defined $ffile0);
    push @ffiles,$ffile1 if (defined $ffile1);
    push @ffiles,$ffile2 if (defined $ffile2);
    push @ffiles,$ffile3 if (defined $ffile3);
}
if (@ffiles) {
    pb_log(2,"DEBUG ffiles: ".Dumper(\@ffiles)."\n");

    foreach my $f (@ffiles) {
        open(CONF,$f) || next;
        while(<CONF>)  {
            if (/^\s*([A-z0-9-_]+)\s+([[A-z0-9-_]+)\s*=\s*(.+)$/) {
                $h{$1}{$2}=$3;
            }
        }
        close(CONF);

        $ptr = $h{"filter"};
        pb_log(2,"DEBUG f:".Dumper($ptr)."\n");
    }
}
return($ptr);
}

# Function which applies filter on pb build files
sub pb_filter_file_pb {

my $f=shift;
my $ptr=shift;
my %filter=%$ptr;
my $destfile=shift;
my $dtype=shift;
my $pbsuf=shift;
my $pbproj=shift;
my $pbpkg=shift;
my $pbver=shift;
my $pbtag=shift;
my $pbrev=shift;
my $pbdate=shift;
my $defpkgdir = shift;
my $extpkgdir = shift;
my $pbpackager = shift;
my $chglog = shift || undef;

pb_log(2,"DEBUG: From $f to $destfile\n");
pb_mkdir_p(dirname($destfile)) if (! -d dirname($destfile));
open(DEST,"> $destfile") || die "Unable to create $destfile";
open(FILE,"$f") || die "Unable to open $f: $!";
while (<FILE>) {
    my $line = $_;
    foreach my $s (keys %filter) {
        # Process single variables
        pb_log(2,"DEBUG filter{$s}: $filter{$s}\n");
        my $tmp = $filter{$s};
        next if (not defined $tmp);
        # Expand variables if any single one found
        pb_log(2,"DEBUG tmp: $tmp\n");
        if ($tmp =~ /\$/) {
            eval { $tmp =~ s/(\$\w+)/$1/eeg };
        # special case for ChangeLog only for pb
        } elsif (($s =~ /^PBLOG$/) && ($line =~ /^PBLOG$/)) {
            my $p = $defpkgdir->{$pbpkg};
            $p = $extpkgdir->{$pbpkg} if (not defined $p);
            pb_changelog($dtype, $pbpkg, $pbver, $pbtag, $pbsuf, $p, \*DEST, $tmp, $chglog);
            $tmp = "";
        }
        $line =~ s|$s|$tmp|;
    }
    print DEST $line;
}
close(FILE);
close(DEST);
}

# Function which applies filter on files (external call)
sub pb_filter_file_inplace {

my $ptr=shift;
my %filter=%$ptr;
my $destfile=shift;
my $pbproj=shift;
my $pbpkg=shift;
my $pbver=shift;
my $pbtag=shift;
my $pbrev=shift;
my $pbdate=shift;
my $pbpackager=shift;

my $cp = "$ENV{'PBTMP'}/".basename($destfile);
copy($destfile,$cp) || die "Unable to create $cp";

pb_filter_file($cp,$ptr,$destfile,$pbproj,$pbpkg,$pbver,$pbtag,$pbrev,$pbdate,$pbpackager);
unlink $cp;
}

# Function which applies filter on files (external call)
sub pb_filter_file {

my $f=shift;
my $ptr=shift;
my %filter=%$ptr;
my $destfile=shift;
my $pbproj=shift;
my $pbpkg=shift;
my $pbver=shift;
my $pbtag=shift;
my $pbrev=shift;
my $pbdate=shift;
my $pbpackager=shift;

pb_log(2,"DEBUG: From $f to $destfile\n");
pb_mkdir_p(dirname($destfile)) if (! -d dirname($destfile));
open(DEST,"> $destfile") || die "Unable to create $destfile";
open(FILE,"$f") || die "Unable to open $f: $!";
while (<FILE>) {
    my $line = $_;
    foreach my $s (keys %filter) {
        # Process single variables
        pb_log(2,"DEBUG filter{$s}: $filter{$s}\n");
        my $tmp = $filter{$s};
        next if (not defined $tmp);
        # Expand variables if any single one found
        if ($tmp =~ /\$/) {
            eval { $tmp =~ s/(\$\w+)/$1/eeg };
        }
        $line =~ s|$s|$tmp|;
    }
    print DEST $line;
}
close(FILE);
close(DEST);
}

1;