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