Changeset 77 in ProjectBuilder for devel/pb/lib/ProjectBuilder

Timestamp:

Sep 3, 2007, 3:34:11 AM (17 years ago)

Author:

Bruno Cornec

Message:

transfer pb_fiter_file to Base and duplicate :-( for external call
Create sub functions per action

File:

• devel/pb/lib/ProjectBuilder/Base.pm (modified) (2 diffs)

devel/pb/lib/ProjectBuilder/Base.pm

@@ -62 +62 @@
         my $pbroot = pb_conf_read($pbrc{$proj},"pbroot");
         my %pbroot = %$pbroot;
-        # There is normaly only one line in it
+        # All lines should point to the same pbroot so take the first
         $ENV{'PBROOT'} = (values %$pbroot)[0] if (defined $pbroot); 
         print $LOG "Using $ENV{'PBROOT'} as default pbroot from $pbrc{$proj}\n" if (($debug >= 0) and (defined $ENV{'PBROOT'}));
@@ -300 +300 @@
 }
 
+# Get all filters to apply
+# They're cumulative from less specific to most specific
+# suffix is .pbf
+
+sub pb_get_filters {
+
+my @ffiles;
+my ($ffile0, $ffile1, $ffile2, $ffile3);
+my $pbpkg = shift || die "No package specified";
+my $dtype = shift || die "No dtype specified";
+my $dfam = shift || die "No dfam specified";
+my $ddir = shift || die "No ddir specified";
+my $dver = shift || die "No dver specified";
+my $ptr; # returned value pointer on the hash of filters
+
+if (-d "$ENV{'PBCONF'}/$pbpkg/pbfilter") {
+    $ffile0 = "$ENV{'PBCONF'}/$pbpkg/pbfilter/$dtype.pbf" if (-f "$ENV{'PBCONF'}/$pbpkg/pbfilter/$dtype.pbf");
+    $ffile1 = "$ENV{'PBCONF'}/$pbpkg/pbfilter/$dfam.pbf" if (-f "$ENV{'PBCONF'}/$pbpkg/pbfilter/$dfam.pbf");
+    $ffile2 = "$ENV{'PBCONF'}/$pbpkg/pbfilter/$ddir.pbf" if (-f "$ENV{'PBCONF'}/$pbpkg/pbfilter/$ddir.pbf");
+    $ffile3 = "$ENV{'PBCONF'}/$pbpkg/pbfilter/$ddir-$dver.pbf" if (-f "$ENV{'PBCONF'}/$pbpkg/pbfilter/$ddir-$dver.pbf");
+
+    push @ffiles,$ffile0 if (defined $ffile0);
+    push @ffiles,$ffile1 if (defined $ffile1);
+    push @ffiles,$ffile2 if (defined $ffile2);
+    push @ffiles,$ffile3 if (defined $ffile3);
+}
+my $config = AppConfig->new({
+    # Auto Create variables mentioned in Conf file
+    CREATE => 1,
+    DEBUG => 0,
+    GLOBAL => {
+        # Each conf item is a hash
+        ARGCOUNT => AppConfig::ARGCOUNT_HASH
+    }
+});
+
+if (@ffiles) {
+    print $LOG "DEBUG ffiles: ".Dumper(\@ffiles)."\n" if ($debug >= 1);
+    $config->file(@ffiles);
+    $ptr = $config->get("filter");
+    print $LOG "DEBUG f:".Dumper($ptr)."\n" if ($debug >= 1);
+} else {
+    $ptr = { };
+}
+return($ptr);
+}
+
+# Function which applies filter on files (only for pb)
+sub pb_filter_file_pb {
+
+my $f=shift;
+my $ptr=shift;
+my %filter=%$ptr;
+my $destfile=shift;
+my $pbpkg=shift;
+my $dtype=shift;
+my $dsuf=shift;
+
+print $LOG "DEBUG: From $f to $destfile\n" if ($debug >= 1);
+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
+        print $LOG "DEBUG filter{$s}: $filter{$s}\n" if ($debug > 1);
+        my $tmp = $filter{$s};
+        next if (not defined $tmp);
+        # Expand variables if any single one found
+        if ($tmp =~ /\$/) {
+            eval { $tmp =~ s/(\$\w+)/$1/eeg };
+        # special case for ChangeLog only for pb
+        } elsif (($tmp =~ /^yes$/) && ($s =~ /^PBLOG$/) && ($line =~ /^PBLOG$/)) {
+            $tmp = "";
+            my $p = $defpkgdir{$pbpkg};
+            $p = $extpkgdir{$pbpkg} if (not defined $p);
+            pb_changelog($dtype, $pbpkg, $pbtag, $dsuf, $p, \*DEST);
+        }
+        $line =~ s|$s|$tmp|;
+    }
+    print DEST $line;
+}
+close(FILE);
+close(DEST);
+}
+
+# Function which applies filter on files (external call)
+sub pb_filter_file {
+
+my $f=shift;
+my $ptr=shift;
+my %filter=%$ptr;
+my $destfile=shift;
+
+print $LOG "DEBUG: From $f to $destfile\n" if ($debug >= 1);
+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
+        print $LOG "DEBUG filter{$s}: $filter{$s}\n" if ($debug > 1);
+        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;