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::Base;
|
---|
21 | use ProjectBuilder::Changelog;
|
---|
22 |
|
---|
23 | # Inherit from the "Exporter" module which handles exporting functions.
|
---|
24 |
|
---|
25 | use Exporter;
|
---|
26 |
|
---|
27 | # Export, by default, all the functions into the namespace of
|
---|
28 | # any code which uses this module.
|
---|
29 |
|
---|
30 | our @ISA = qw(Exporter);
|
---|
31 | our @EXPORT = qw(pb_get_filters pb_filter_file_pb pb_filter_file_inplace pb_filter_file);
|
---|
32 |
|
---|
33 | =pod
|
---|
34 |
|
---|
35 | =head1 NAME
|
---|
36 |
|
---|
37 | ProjectBuilder::Base, part of the project-builder.org - module dealing with generic functions suitable for perl project development
|
---|
38 |
|
---|
39 | =head1 DESCRIPTION
|
---|
40 |
|
---|
41 | pb helps you build various packages directly from your project sources.
|
---|
42 | Those sources could be handled by a CMS (Configuration Management System)
|
---|
43 | such as Subversion, CVS, ... or being a simple reference to a compressed tar file.
|
---|
44 | It's based on a set of configuration files, a set of provided macros to help
|
---|
45 | you keeping build files as generic as possible. For example, a single .spec
|
---|
46 | file should be required to generate for all rpm based distributions, even
|
---|
47 | if you could also have multiple .spec files if required.
|
---|
48 |
|
---|
49 | =cut
|
---|
50 |
|
---|
51 | # Get all filters to apply
|
---|
52 | # They're cumulative from less specific to most specific
|
---|
53 | # suffix is .pbf
|
---|
54 |
|
---|
55 | sub pb_get_filters {
|
---|
56 |
|
---|
57 | my @ffiles;
|
---|
58 | my ($ffile00, $ffile0, $ffile1, $ffile2, $ffile3);
|
---|
59 | my ($mfile00, $mfile0, $mfile1, $mfile2, $mfile3);
|
---|
60 | my $pbpkg = shift || die "No package specified";
|
---|
61 | my $dtype = shift || "";
|
---|
62 | my $dfam = shift || "";
|
---|
63 | my $ddir = shift || "";
|
---|
64 | my $dver = shift || "";
|
---|
65 | my $ptr = undef; # returned value pointer on the hash of filters
|
---|
66 | my %h;
|
---|
67 |
|
---|
68 | # Global filter files first, then package specificities
|
---|
69 | if (-d "$ENV{'PBROOTDIR'}/pbfilter") {
|
---|
70 | $mfile00 = "$ENV{'PBROOTDIR'}/pbfilter/all.pbf" if (-f "$ENV{'PBROOTDIR'}/pbfilter/all.pbf");
|
---|
71 | $mfile0 = "$ENV{'PBROOTDIR'}/pbfilter/$dtype.pbf" if (-f "$ENV{'PBROOTDIR'}/pbfilter/$dtype.pbf");
|
---|
72 | $mfile1 = "$ENV{'PBROOTDIR'}/pbfilter/$dfam.pbf" if (-f "$ENV{'PBROOTDIR'}/pbfilter/$dfam.pbf");
|
---|
73 | $mfile2 = "$ENV{'PBROOTDIR'}/pbfilter/$ddir.pbf" if (-f "$ENV{'PBROOTDIR'}/pbfilter/$ddir.pbf");
|
---|
74 | $mfile3 = "$ENV{'PBROOTDIR'}/pbfilter/$ddir-$dver.pbf" if (-f "$ENV{'PBROOTDIR'}/pbfilter/$ddir-$dver.pbf");
|
---|
75 |
|
---|
76 | push @ffiles,$mfile00 if (defined $mfile00);
|
---|
77 | push @ffiles,$mfile0 if (defined $mfile0);
|
---|
78 | push @ffiles,$mfile1 if (defined $mfile1);
|
---|
79 | push @ffiles,$mfile2 if (defined $mfile2);
|
---|
80 | push @ffiles,$mfile3 if (defined $mfile3);
|
---|
81 | }
|
---|
82 |
|
---|
83 | if (-d "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter") {
|
---|
84 | $ffile00 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/all.pbf" if (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/all.pbf");
|
---|
85 | $ffile0 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$dtype.pbf" if (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$dtype.pbf");
|
---|
86 | $ffile1 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$dfam.pbf" if (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$dfam.pbf");
|
---|
87 | $ffile2 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$ddir.pbf" if (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$ddir.pbf");
|
---|
88 | $ffile3 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$ddir-$dver.pbf" if (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$ddir-$dver.pbf");
|
---|
89 |
|
---|
90 | push @ffiles,$ffile00 if (defined $ffile00);
|
---|
91 | push @ffiles,$ffile0 if (defined $ffile0);
|
---|
92 | push @ffiles,$ffile1 if (defined $ffile1);
|
---|
93 | push @ffiles,$ffile2 if (defined $ffile2);
|
---|
94 | push @ffiles,$ffile3 if (defined $ffile3);
|
---|
95 | }
|
---|
96 | if (@ffiles) {
|
---|
97 | pb_log(2,"DEBUG ffiles: ".Dumper(\@ffiles)."\n");
|
---|
98 |
|
---|
99 | foreach my $f (@ffiles) {
|
---|
100 | open(CONF,$f) || next;
|
---|
101 | while(<CONF>) {
|
---|
102 | if (/^\s*([A-z0-9-_]+)\s+([[A-z0-9-_]+)\s*=\s*(.+)$/) {
|
---|
103 | $h{$1}{$2}=$3;
|
---|
104 | }
|
---|
105 | }
|
---|
106 | close(CONF);
|
---|
107 |
|
---|
108 | $ptr = $h{"filter"};
|
---|
109 | pb_log(2,"DEBUG f:".Dumper($ptr)."\n");
|
---|
110 | }
|
---|
111 | }
|
---|
112 | return($ptr);
|
---|
113 | }
|
---|
114 |
|
---|
115 | # Function which applies filter on pb build files
|
---|
116 | sub pb_filter_file_pb {
|
---|
117 |
|
---|
118 | my $f=shift;
|
---|
119 | my $ptr=shift;
|
---|
120 | my %filter=%$ptr;
|
---|
121 | my $destfile=shift;
|
---|
122 | my $dtype=shift;
|
---|
123 | my $pbsuf=shift;
|
---|
124 | my $pbproj=shift;
|
---|
125 | my $pbpkg=shift;
|
---|
126 | my $pbver=shift;
|
---|
127 | my $pbtag=shift;
|
---|
128 | my $pbrev=shift;
|
---|
129 | my $pbdate=shift;
|
---|
130 | my $defpkgdir = shift;
|
---|
131 | my $extpkgdir = shift;
|
---|
132 | my $pbpackager = shift;
|
---|
133 | my $chglog = shift || undef;
|
---|
134 |
|
---|
135 | pb_log(2,"DEBUG: From $f to $destfile\n");
|
---|
136 | pb_mkdir_p(dirname($destfile)) if (! -d dirname($destfile));
|
---|
137 | open(DEST,"> $destfile") || die "Unable to create $destfile";
|
---|
138 | open(FILE,"$f") || die "Unable to open $f: $!";
|
---|
139 | while (<FILE>) {
|
---|
140 | my $line = $_;
|
---|
141 | foreach my $s (keys %filter) {
|
---|
142 | # Process single variables
|
---|
143 | pb_log(2,"DEBUG filter{$s}: $filter{$s}\n");
|
---|
144 | my $tmp = $filter{$s};
|
---|
145 | next if (not defined $tmp);
|
---|
146 | # Expand variables if any single one found
|
---|
147 | pb_log(2,"DEBUG tmp: $tmp\n");
|
---|
148 | if ($tmp =~ /\$/) {
|
---|
149 | eval { $tmp =~ s/(\$\w+)/$1/eeg };
|
---|
150 | # special case for ChangeLog only for pb
|
---|
151 | } elsif (($s =~ /^PBLOG$/) && ($line =~ /^PBLOG$/)) {
|
---|
152 | my $p = $defpkgdir->{$pbpkg};
|
---|
153 | $p = $extpkgdir->{$pbpkg} if (not defined $p);
|
---|
154 | pb_changelog($dtype, $pbpkg, $pbver, $pbtag, $pbsuf, $p, \*DEST, $tmp, $chglog);
|
---|
155 | $tmp = "";
|
---|
156 | }
|
---|
157 | $line =~ s|$s|$tmp|;
|
---|
158 | }
|
---|
159 | print DEST $line;
|
---|
160 | }
|
---|
161 | close(FILE);
|
---|
162 | close(DEST);
|
---|
163 | }
|
---|
164 |
|
---|
165 | # Function which applies filter on files (external call)
|
---|
166 | sub pb_filter_file_inplace {
|
---|
167 |
|
---|
168 | my $ptr=shift;
|
---|
169 | my %filter=%$ptr;
|
---|
170 | my $destfile=shift;
|
---|
171 | my $pbproj=shift;
|
---|
172 | my $pbpkg=shift;
|
---|
173 | my $pbver=shift;
|
---|
174 | my $pbtag=shift;
|
---|
175 | my $pbrev=shift;
|
---|
176 | my $pbdate=shift;
|
---|
177 | my $pbpackager=shift;
|
---|
178 |
|
---|
179 | my $cp = "$ENV{'PBTMP'}/".basename($destfile);
|
---|
180 | copy($destfile,$cp) || die "Unable to create $cp";
|
---|
181 |
|
---|
182 | pb_filter_file($cp,$ptr,$destfile,$pbproj,$pbpkg,$pbver,$pbtag,$pbrev,$pbdate,$pbpackager);
|
---|
183 | unlink $cp;
|
---|
184 | }
|
---|
185 |
|
---|
186 | # Function which applies filter on files (external call)
|
---|
187 | sub pb_filter_file {
|
---|
188 |
|
---|
189 | my $f=shift;
|
---|
190 | my $ptr=shift;
|
---|
191 | my %filter=%$ptr;
|
---|
192 | my $destfile=shift;
|
---|
193 | my $pbproj=shift;
|
---|
194 | my $pbpkg=shift;
|
---|
195 | my $pbver=shift;
|
---|
196 | my $pbtag=shift;
|
---|
197 | my $pbrev=shift;
|
---|
198 | my $pbdate=shift;
|
---|
199 | my $pbpackager=shift;
|
---|
200 |
|
---|
201 | pb_log(2,"DEBUG: From $f to $destfile\n");
|
---|
202 | pb_mkdir_p(dirname($destfile)) if (! -d dirname($destfile));
|
---|
203 | open(DEST,"> $destfile") || die "Unable to create $destfile";
|
---|
204 | open(FILE,"$f") || die "Unable to open $f: $!";
|
---|
205 | while (<FILE>) {
|
---|
206 | my $line = $_;
|
---|
207 | foreach my $s (keys %filter) {
|
---|
208 | # Process single variables
|
---|
209 | pb_log(2,"DEBUG filter{$s}: $filter{$s}\n");
|
---|
210 | my $tmp = $filter{$s};
|
---|
211 | next if (not defined $tmp);
|
---|
212 | # Expand variables if any single one found
|
---|
213 | if ($tmp =~ /\$/) {
|
---|
214 | eval { $tmp =~ s/(\$\w+)/$1/eeg };
|
---|
215 | }
|
---|
216 | $line =~ s|$s|$tmp|;
|
---|
217 | }
|
---|
218 | print DEST $line;
|
---|
219 | }
|
---|
220 | close(FILE);
|
---|
221 | close(DEST);
|
---|
222 | }
|
---|
223 |
|
---|
224 | 1;
|
---|