[svn:parrot] r48653 - trunk/lib/Parrot/Configure
gerd at svn.parrot.org
gerd at svn.parrot.org
Wed Aug 25 16:34:21 UTC 2010
Author: gerd
Date: Wed Aug 25 16:34:20 2010
New Revision: 48653
URL: https://trac.parrot.org/parrot/changeset/48653
Log:
add a method to replace entries like "@key@" only for shebang at the first line of a file
Modified:
trunk/lib/Parrot/Configure/Compiler.pm
Modified: trunk/lib/Parrot/Configure/Compiler.pm
==============================================================================
--- trunk/lib/Parrot/Configure/Compiler.pm Wed Aug 25 12:05:24 2010 (r48652)
+++ trunk/lib/Parrot/Configure/Compiler.pm Wed Aug 25 16:34:20 2010 (r48653)
@@ -1,15 +1,17 @@
-# Copyright (C) 2001-2008, Parrot Foundation.
+# Copyright (C) 2001-2010, Parrot Foundation.
# $Id$
=head1 NAME
-Parrot::Configure::Compiler - C-Related methods for configuration
+Parrot::Configure::Compiler - C-Related methods for configuration and more
=head1 DESCRIPTION
The Parrot::Configure::Compiler module provides methods inherited by
Parrot::Configure which prepare and/or run C programs during
-compilation.
+compilation. Also other files like makefiles will be generated with methods
+from this module by replacing entries like C<@key@> with C<key>'s value from
+the configuration system's data.
=head2 Methods
@@ -193,6 +195,49 @@
qw( .exe.manifest .ilk .pdb );
}
+=item C<shebang_mod()>
+
+ $conf->shebang_mod($source, $target);
+
+Takes the specified source file, replacing entries like C<@key@> with
+C<key>'s value from the configuration system's data, and writes the results
+to specified target file. The replacement is only done in the first line of
+the file normally to set the shebang value accordingly.
+
+=cut
+
+sub shebang_mod {
+ my $conf = shift;
+ my ( $source, $target ) = @_;
+
+ open my $in, '<', $source or die "Can't open $source: $!";
+ open my $out, '>', "$target.tmp" or die "Can't open $target.tmp: $!";
+
+ my $line = <$in>;
+
+ # interpolate @foo@ values
+ $line =~ s{ \@ (\w+) \@ }{
+ if(defined(my $val=$conf->data->get($1))) {
+ $val;
+ }
+ else {
+ warn "value for '\@$1\@' in $source is undef";
+ '';
+ }
+ }egx;
+
+ print $out $line;
+
+ while ( my $line = <$in> ) {
+ print $out $line;
+ }
+
+ close($in) or die "Can't close $source: $!";
+ close($out) or die "Can't close $target: $!";
+
+ move_if_diff( "$target.tmp", $target );
+}
+
=item C<genfile()>
$conf->genfile($source, $target, %options);
More information about the parrot-commits
mailing list