[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