1 # Copyright (C) 2001-2009, Parrot Foundation.
4 package Parrot
::BuildUtil
;
11 Parrot::BuildUtil - Utilities for building Parrot
15 This package holds pre-configure time subroutines, which are not exported
16 and should not require Parrot::Config.
17 Each must be requested by using a fully qualified name.
23 =item C<parrot_version()>
25 Determines the current version number for Parrot from the VERSION file
26 and returns it in a context-appropriate manner.
28 $parrot_version = Parrot::BuildUtil::parrot_version();
29 # $parrot_version is '0.4.11'
31 @parrot_version = Parrot::BuildUtil::parrot_version();
32 # @parrot_version is (0, 4, 11)
36 # cache for repeated calls
37 my ( $parrot_version, @parrot_version );
40 if ( defined $parrot_version ) {
41 return wantarray ?
@parrot_version : $parrot_version;
44 # Obtain the official version number from the VERSION file.
46 open my $VERSION, '<', 'VERSION' or die 'Could not open VERSION file!';
47 chomp( $parrot_version = <$VERSION> );
48 close $VERSION or die $!;
50 else { # we're in an installed copy of Parrot
52 $path = '' unless $path;
53 open my $VERSION, '<', "$path/VERSION" or die 'Could not open VERSION file!';
54 chomp( $parrot_version = <$VERSION> );
55 close $VERSION or die $!;
58 $parrot_version =~ s/\s+//g;
59 @parrot_version = split( /\./, $parrot_version );
61 if ( scalar(@parrot_version) < 3 ) {
62 die "Too few components to VERSION file contents: '$parrot_version' (should be 3 or 4)!";
65 if ( scalar(@parrot_version) > 4 ) {
66 die "Too many components to VERSION file contents: '$parrot_version' (should be 3 or 4)!";
69 foreach my $component (@parrot_version) {
70 die "Illegal version component: '$component' in VERSION file!"
71 unless $component =~ m/^\d+$/;
74 $parrot_version = join( '.', @parrot_version );
75 return wantarray ?
@parrot_version : $parrot_version;
78 =item C<slurp_file($filename)>
80 Slurps up the filename and returns the content as one string. While
81 doing so, it converts all DOS-style line endings to newlines.
88 open( my $SLURP, '<', $file_name ) or die "open '$file_name': $!";
90 my $file = <$SLURP> . '';
91 $file =~ s/\cM\cJ/\n/g;
92 close $SLURP or die $!;
97 =item C<generated_file_header($filename, $style)>
99 Returns a comment to mark a generated file and detail how it was created.
100 C<$filename> is the name of the file on which the generated file is based,
101 C<$style> is the style of comment--C<'perl'> and C<'c'> are permitted, other
102 values produce an error.
106 sub generated_file_header
{
107 my ( $filename, $style ) = @_;
109 die qq{unknown style
"$style"}
110 if $style !~ m/\A(?:perl|c)\z/;
113 my $script = File
::Spec
->abs2rel($0);
114 $script =~ s/\\/\//g
;
116 my $header = <<"END_HEADER";
118 * !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
120 * This file is generated automatically from '$filename'
123 * Any changes made here will be lost!
128 if ( $style eq 'perl' ) {
129 $header =~ s/^\/\*(.*?)ft=c:/# $1ft=perl:/;
130 $header =~ s/\n \*\n \*\///;
131 $header =~ s/^ \* ?/# /msg;
137 =item C<get_bc_version()>
139 Return an array of ($bc_major, $bc_minor) from F<PBC_COMPAT>.
140 This is used in the native_pbc tests.
142 See also F<tools/dev/pbc_header.pl> and F<tools/build/pbcversion_h.pl>.
147 my $compat_file = 'PBC_COMPAT';
148 my ( $bc_major, $bc_minor );
149 open my $IN, '<', $compat_file or die "Can't read $compat_file";
151 if (/^(\d+)\.0*(\d+)/) {
152 ( $bc_major, $bc_minor ) = ( $1, $2 );
156 unless ( defined $bc_major ) {
157 die "No bytecode version found in '$compat_file'.";
160 return ( $bc_major, $bc_minor );
171 # cperl-indent-level: 4
174 # vim: expandtab shiftwidth=4: