# Copyright (C) 2001-2012, Parrot Foundation.

package Parrot::BuildUtil;

use strict;
use warnings;
use vars qw( @ISA @EXPORT );
use Exporter;
@ISA = qw( Exporter );
@EXPORT = qw( add_to_generated );

use File::Basename qw/basename/;
use File::Spec;

=head1 NAME

Parrot::BuildUtil - Utilities for building Parrot

=head1 DESCRIPTION

This package holds pre-configure time subroutines, which are not exported
and should not require Parrot::Config.

One exception though: C<add_to_generated()> is exported.

=head1 SUBROUTINES

=over 4

=item C<parrot_version()>

Determines the current version number for Parrot from the VERSION file
and returns it in a context-appropriate manner.

    $parrot_version = Parrot::BuildUtil::parrot_version();
    # $parrot_version is '0.4.11'

    @parrot_version = Parrot::BuildUtil::parrot_version();
    # @parrot_version is (0, 4, 11)

=cut

# cache for repeated calls
my ( $parrot_version, @parrot_version );

sub parrot_version {
    if ( defined $parrot_version ) {
        return wantarray ? @parrot_version : $parrot_version;
    }

    # Obtain the official version number from the VERSION file.
    if (-e 'VERSION') {
        open my $VERSION, '<', 'VERSION' or die 'Could not open VERSION file!';
        chomp( $parrot_version = <$VERSION> );
        close $VERSION or die $!;
    }
    else { # we're in an installed copy of Parrot
        my $path = shift;
        $path = '' unless $path;
        open my $VERSION, '<', "$path/VERSION" or die 'Could not open VERSION file!';
        chomp( $parrot_version = <$VERSION> );
        close $VERSION or die $!;
    }

    $parrot_version =~ s/\s+//g;
    @parrot_version = split( /\./, $parrot_version );

    if ( scalar(@parrot_version) < 3 ) {
        die "Too few components to VERSION file contents: '$parrot_version' (should be 3 or 4)!";
    }

    if ( scalar(@parrot_version) > 4 ) {
        die "Too many components to VERSION file contents: '$parrot_version' (should be 3 or 4)!";
    }

    foreach my $component (@parrot_version) {
        die "Illegal version component: '$component' in VERSION file!"
            unless $component =~ m/^\d+$/;
    }

    $parrot_version = join( '.', @parrot_version );
    return wantarray ? @parrot_version : $parrot_version;
}

=item C<slurp_file($filename)>

Slurps up the filename and returns the content as one string.  While
doing so, it converts all DOS-style line endings to newlines.

=cut

sub slurp_file {
    my ($file_name) = @_;

    open( my $SLURP, '<', $file_name ) or die "open '$file_name': $!";
    local $/ = undef;
    my $file = <$SLURP> . '';
    $file =~ s/\cM\cJ/\n/g;
    close $SLURP or die $!;

    return $file;
}

=item C<generated_file_header($filename, $style)>

Returns a comment to mark a generated file and detail how it was created.
C<$filename> is the name of the file on which the generated file is based,
C<$style> is the style of comment--C<'perl'> and C<'c'> are permitted, other
values produce an error.

=cut

sub generated_file_header {
    my ( $filename, $style ) = @_;

    die qq{unknown style "$style"}
        unless ($style eq 'perl' or $style eq 'c');

    my $script = File::Spec->abs2rel($0);
    $script =~ s/\\/\//g;

    my $header = <<"END_HEADER";
/* ex: set ro ft=c:
 * !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
 *
 * This file is generated automatically from '$filename'
 * by $script.
 *
 * Any changes made here will be lost!
 *
 */
END_HEADER

    if ( $style eq 'perl' ) {
        $header =~ s/^\/\*(.*?)ft=c:/# $1ft=perl:/;
        $header =~ s/\n \*\n \*\///;
        $header =~ s/^ \* ?/#  /msg;
    }

    return $header;
}

=item C<get_bc_version()>

Return an array of ($bc_major, $bc_minor) from F<PBC_COMPAT>.
This is used in the native_pbc tests.

See also F<tools/dev/pbc_header.pl> and F<tools/build/pbcversion_h.pl>.

=cut

sub get_bc_version {
    my $compat_file = 'PBC_COMPAT';
    my ( $bc_major, $bc_minor );
    open my $IN, '<', $compat_file or die "Can't read $compat_file";
    while (<$IN>) {
        if (/^(\d+)\.0*(\d+)/) {
            ( $bc_major, $bc_minor ) = ( $1, $2 );
            last;
        }
    }
    close $IN or die "Couldn't close $compat_file";
    unless ( defined $bc_major ) {
        die "No bytecode version found in '$compat_file'.";
    }
    return ( $bc_major, $bc_minor );
}

=item C<add_to_generated($filename, $section, $dir)>

Adds the C<$filename> to MANIFEST.generated into the given C<$section>.
C<$dir> is optional.

Default section: [main]
Default dir: ""

Note that Parrot::Config might not be generated yet, so
we must assure that the current directory is the the build_dir.
This is the job of F<tools/build/addgenerated.pl>, but
within some perl5 modules you must take care by yourself.

=cut

sub add_to_generated {
    my ($filename, $section, $dir) = @_;

    # Support quirky Makefile invocation as
    #   $(PERL) -Ilib -MParrot::BuildUtil -e add_to_generated "$@",'[main]','lib'
    ($filename, $section, $dir) = @ARGV unless $filename;
    if ($filename =~ /,/ and !$section) { # split it here, when the shell is fooled
        ($filename, $section, $dir) = split /,/, $filename;
    }

    my $path = File::Spec->abs2rel($filename);
    $path =~ s/\\/\//g;
    $section = "[main]" unless $section;
    $dir = "" unless $dir;

    open( my $M, '>>', "MANIFEST.generated" ) or die "open 'MANIFEST.generated': $!";
    printf $M "%-48s %s%s\n", $path, $section, $dir;

    # Additional .manifest logic on windows and [main]bin
    if ($section eq '[main]' and $dir eq 'bin' and $^O =~ /cygwin|MSWin32/) {
        my $base = basename($filename,'.exe');
        if (-e "$base.manifest") {
            my $mpath = File::Spec->abs2rel($base) . ".manifest";
            $mpath =~ s/\\/\//g;
            printf $M "%-48s %s%s\n", $mpath, $section, $dir;
        }
    }
    close $M;
    ''
}

=item C<add_list_to_generated( [$section,] @files)>

Adds the list of filenames to MANIFEST.generated into $section,
Default main: '[main]'.

=cut

sub add_list_to_generated {
    @_ = @ARGV unless @_;
    my $section = '';
    $section = shift @_ if $_[0] =~ /^\[/;
    add_to_generated($_, $section) for @_;
}

1;

=back

=cut

# Local Variables:
#   mode: cperl
#   cperl-indent-level: 4
#   fill-column: 100
# End:
# vim: expandtab shiftwidth=4:
