1# Copyright (C) 2001-2012, Parrot Foundation. 2 3package Parrot::BuildUtil; 4 5use strict; 6use warnings; 7use vars qw( @ISA @EXPORT ); 8use Exporter; 9@ISA = qw( Exporter ); 10@EXPORT = qw( add_to_generated ); 11 12use File::Basename qw/basename/; 13use File::Spec; 14 15=head1 NAME 16 17Parrot::BuildUtil - Utilities for building Parrot 18 19=head1 DESCRIPTION 20 21This package holds pre-configure time subroutines, which are not exported 22and should not require Parrot::Config. 23 24One exception though: C<add_to_generated()> is exported. 25 26=head1 SUBROUTINES 27 28=over 4 29 30=item C<parrot_version()> 31 32Determines the current version number for Parrot from the VERSION file 33and returns it in a context-appropriate manner. 34 35 $parrot_version = Parrot::BuildUtil::parrot_version(); 36 # $parrot_version is '0.4.11' 37 38 @parrot_version = Parrot::BuildUtil::parrot_version(); 39 # @parrot_version is (0, 4, 11) 40 41=cut 42 43# cache for repeated calls 44my ( $parrot_version, @parrot_version ); 45 46sub parrot_version { 47 if ( defined $parrot_version ) { 48 return wantarray ? @parrot_version : $parrot_version; 49 } 50 51 # Obtain the official version number from the VERSION file. 52 if (-e 'VERSION') { 53 open my $VERSION, '<', 'VERSION' or die 'Could not open VERSION file!'; 54 chomp( $parrot_version = <$VERSION> ); 55 close $VERSION or die $!; 56 } 57 else { # we're in an installed copy of Parrot 58 my $path = shift; 59 $path = '' unless $path; 60 open my $VERSION, '<', "$path/VERSION" or die 'Could not open VERSION file!'; 61 chomp( $parrot_version = <$VERSION> ); 62 close $VERSION or die $!; 63 } 64 65 $parrot_version =~ s/\s+//g; 66 @parrot_version = split( /\./, $parrot_version ); 67 68 if ( scalar(@parrot_version) < 3 ) { 69 die "Too few components to VERSION file contents: '$parrot_version' (should be 3 or 4)!"; 70 } 71 72 if ( scalar(@parrot_version) > 4 ) { 73 die "Too many components to VERSION file contents: '$parrot_version' (should be 3 or 4)!"; 74 } 75 76 foreach my $component (@parrot_version) { 77 die "Illegal version component: '$component' in VERSION file!" 78 unless $component =~ m/^\d+$/; 79 } 80 81 $parrot_version = join( '.', @parrot_version ); 82 return wantarray ? @parrot_version : $parrot_version; 83} 84 85=item C<slurp_file($filename)> 86 87Slurps up the filename and returns the content as one string. While 88doing so, it converts all DOS-style line endings to newlines. 89 90=cut 91 92sub slurp_file { 93 my ($file_name) = @_; 94 95 open( my $SLURP, '<', $file_name ) or die "open '$file_name': $!"; 96 local $/ = undef; 97 my $file = <$SLURP> . ''; 98 $file =~ s/\cM\cJ/\n/g; 99 close $SLURP or die $!; 100 101 return $file; 102} 103 104=item C<generated_file_header($filename, $style)> 105 106Returns a comment to mark a generated file and detail how it was created. 107C<$filename> is the name of the file on which the generated file is based, 108C<$style> is the style of comment--C<'perl'> and C<'c'> are permitted, other 109values produce an error. 110 111=cut 112 113sub generated_file_header { 114 my ( $filename, $style ) = @_; 115 116 die qq{unknown style "$style"} 117 unless ($style eq 'perl' or $style eq 'c'); 118 119 my $script = File::Spec->abs2rel($0); 120 $script =~ s/\\/\//g; 121 122 my $header = <<"END_HEADER"; 123/* ex: set ro ft=c: -*- buffer-read-only:t -*- 124 * !!!!!!! DO NOT EDIT THIS FILE !!!!!!! 125 * 126 * This file is generated automatically from '$filename' 127 * by $script. 128 * 129 * Any changes made here will be lost! 130 * 131 */ 132END_HEADER 133 134 if ( $style eq 'perl' ) { 135 $header =~ s/^\/\*(.*?)ft=c:/# $1ft=perl:/; 136 $header =~ s/\n \*\n \*\///; 137 $header =~ s/^ \* ?/# /msg; 138 } 139 140 return $header; 141} 142 143=item C<get_bc_version()> 144 145Return an array of ($bc_major, $bc_minor) from F<PBC_COMPAT>. 146This is used in the native_pbc tests. 147 148See also F<tools/dev/pbc_header.pl> and F<tools/build/pbcversion_h.pl>. 149 150=cut 151 152sub get_bc_version { 153 my $compat_file = 'PBC_COMPAT'; 154 my ( $bc_major, $bc_minor ); 155 open my $IN, '<', $compat_file or die "Can't read $compat_file"; 156 while (<$IN>) { 157 if (/^(\d+)\.0*(\d+)/) { 158 ( $bc_major, $bc_minor ) = ( $1, $2 ); 159 last; 160 } 161 } 162 close $IN or die "Couldn't close $compat_file"; 163 unless ( defined $bc_major ) { 164 die "No bytecode version found in '$compat_file'."; 165 } 166 return ( $bc_major, $bc_minor ); 167} 168 169=item C<add_to_generated($filename, $section, $dir)> 170 171Adds the C<$filename> to MANIFEST.generated into the given C<$section>. 172C<$dir> is optional. 173 174Default section: [main] 175Default dir: "" 176 177Note that Parrot::Config might not be generated yet, so 178we must assure that the current directory is the the build_dir. 179This is the job of F<tools/build/addgenerated.pl>, but 180within some perl5 modules you must take care by yourself. 181 182=cut 183 184sub add_to_generated { 185 my ($filename, $section, $dir) = @_; 186 187 # Support quirky Makefile invocation as 188 # $(PERL) -Ilib -MParrot::BuildUtil -e add_to_generated "$@",'[main]','lib' 189 ($filename, $section, $dir) = @ARGV unless $filename; 190 if ($filename =~ /,/ and !$section) { # split it here, when the shell is fooled 191 ($filename, $section, $dir) = split /,/, $filename; 192 } 193 194 my $path = File::Spec->abs2rel($filename); 195 $path =~ s/\\/\//g; 196 $section = "[main]" unless $section; 197 $dir = "" unless $dir; 198 199 open( my $M, '>>', "MANIFEST.generated" ) or die "open 'MANIFEST.generated': $!"; 200 printf $M "%-48s %s%s\n", $path, $section, $dir; 201 202 # Additional .manifest logic on windows and [main]bin 203 if ($section eq '[main]' and $dir eq 'bin' and $^O =~ /cygwin|MSWin32/) { 204 my $base = basename($filename,'.exe'); 205 if (-e "$base.manifest") { 206 my $mpath = File::Spec->abs2rel($base) . ".manifest"; 207 $mpath =~ s/\\/\//g; 208 printf $M "%-48s %s%s\n", $mpath, $section, $dir; 209 } 210 } 211 close $M; 212 '' 213} 214 215=item C<add_list_to_generated( [$section,] @files)> 216 217Adds the list of filenames to MANIFEST.generated into $section, 218Default main: '[main]'. 219 220=cut 221 222sub add_list_to_generated { 223 @_ = @ARGV unless @_; 224 my $section = ''; 225 $section = shift @_ if $_[0] =~ /^\[/; 226 add_to_generated($_, $section) for @_; 227} 228 2291; 230 231=back 232 233=cut 234 235# Local Variables: 236# mode: cperl 237# cperl-indent-level: 4 238# fill-column: 100 239# End: 240# vim: expandtab shiftwidth=4: 241