<commit_before># Copyright (C) 2007-2008, The Perl Foundation.
# $Id$
package Parrot::Ops2c::Utils;
use strict;
use warnings;
use lib ("lib/");
use Parrot::OpLib::core;
use Parrot::OpsFile;
use File::Spec;
use IO::File;

=head1 NAME

Parrot::Ops2c::Utils - Methods holding functionality for F<tools/build/ops2c.pl>.

=head1 SYNOPSIS

    $self = Parrot::Ops2c::Utils->new( {
        argv    => [ @ARGV ],
        flag    => Parrot::Ops2c::Auxiliary::getoptions(),
        script  => $0,
    } );

    $c_header_filename = $self->print_c_header_file();

    $c_source_filename = $self->print_c_source_file();

=head1 DESCRIPTION

Parrot::Ops2c::Utils provides methods called by F<tools/build/ops2c.pl>, a
program which is called at various points in the Parrot F<make> process.
The program's function is to create a pair of C header (F<*.h>) and
implementation (F<*.c>) files from the operation definitions found in
one or more F<*.ops> files.

The functionality originally found in F<tools/build/ops2c.pl> has been
extracted into this package's methods in order to support component-focused
testing and future refactoring.

=head1 METHODS

=head2 C<new()>

=over 4

=item * Purpose

Process command-line arguments provided to F<tools/build/ops2c.pl>; construct
and initialize a Parrot::Ops2c::Utils object.

=item * Arguments

Hash reference with the following elements:

    argv        :   reference to @ARGV
    flag        :   hash reference which is the return value of
                    Parrot::Ops2c::Utils::getoptions();
                    hash will have keys such as 'core', 'dynamic' or 'nolines'
    script      :   name of the script to be executed by 'make'
                    (generally, $0 or tools/build/ops2c.pl)

=item * Return Value

Parrot::Ops2c::Utils object.  At this point, the caller is ready to open a
handle to the C-header file and write to it.

=item * Comment

Arguments for the constructor have been selected so as to provide
subsequent methods with all information needed to execute properly and to be
testable.

=back

=cut

sub new {
    my ( $class, $argsref ) = @_;
    unless ( defined $argsref->{flag} ) {
        print STDERR
            "Parrot::Ops2c::Utils::new() requires reference to hash of command-line options: $!";
        return;
    }
    my $flagref = $argsref->{flag};
    my @argv    = @{ $argsref->{argv} };
    $argsref->{script} ||= "tools/build/ops2c.pl";
    unless (@argv) {
        print STDERR "Parrot::Ops2c::Utils::new() requires 'trans' options: $!";
        return;
    }
    my $class_name = shift @argv;
    my %is_allowed = map { $_ => 1 } qw(C CGoto CGP CSwitch CPrederef);
    unless ( $is_allowed{$class_name} ) {
        print STDERR
            "Parrot::Ops2c::Utils::new() requires C, CGoto, CGP, CSwitch and/or  CPrederef: $!";
        return;
    }

    my $trans_class = "Parrot::OpTrans::" . $class_name;
    eval "require $trans_class";
    my $trans = $trans_class->new();

    # Don't yet know how to test the following.
    unless ( defined $trans ) {
        print STDERR "Unable to construct $trans object: $!";
        return;
    }

    my $suffix = $trans->suffix();    # Invoked (sometimes) as ${suffix}

    my $file = $flagref->{core} ? 'core.ops' : shift @argv;
    my $base = $file;    # Invoked (sometimes) as ${base}
    $base =~ s/\.ops$//;
    my $base_ops_stub = $base . q{_ops} . $suffix;
    my $base_ops_h    = $base_ops_stub . q{.h};

    my $incdir  = "include/parrot/oplib";
    my $include = "parrot/oplib/$base_ops_h";
    my $header  = "include/$include";

    # A partially written file will confuse make -j and make error recovery
    # problematic.  create a temp file and rename it afterward.
    my $source = "src/ops/$base_ops_stub.c.temp";

    if ( $flagref->{dynamic} ) {
        $source =~ s!src/ops/!!;
        $header = $base_ops_h;
        $base =~ s!^.*[/\\]!!;
        $include = $base_ops_h;
        $flagref->{dynamic} = 1;
    }

    my $sym_export =
        $flagref->{dynamic}
        ? 'PARROT_DYNEXT_EXPORT'
        : 'PARROT_API';

    my $ops;
    if ( $flagref->{core} ) {
        $ops = _prepare_core(
            {
                file => $file,
                flag => $flagref,
            }
        );
    }
    else {
        $ops = _prepare_non_core(
            {
                file   => $file,
                argv   => [@argv],
                flag   => $flagref,
                script => $argsref->{script},
            }
        );
    }

    my %versions = (
        major => $ops->major_version,
        minor => $ops->minor_version,
        patch => $ops->patch_version,
    );
    my $num_ops     = scalar $ops->ops;
    my $num_entries = $num_ops + 1;       # For trailing NULL

    if ( !$flagref->{dynamic} && !-d $incdir ) {
        mkdir( $incdir, 0755 )
            or die "ops2c.pl: Could not mkdir $incdir $!!\n";
    }

    my $preamble = _compose_preamble( $file, $argsref->{script} );

    my $init_func = join q{_},
        ( q{Parrot}, q{DynOp}, $base . $suffix, @versions{qw(major minor patch)}, );

    ##### Populate the object #####
    $argsref->{argv}   = \@argv;
    $argsref->{trans}  = $trans;
    $argsref->{suffix} = $suffix;

    $argsref->{file}       = $file;
    $argsref->{base}       = $base;
    $argsref->{incdir}     = $incdir;
    $argsref->{include}    = $include;
    $argsref->{header}     = $header;
    $argsref->{source}     = $source;
    $argsref->{sym_export} = $sym_export;

    $argsref->{ops}         = $ops;
    $argsref->{versions}    = \%versions;
    $argsref->{num_ops}     = $num_ops;
    $argsref->{num_entries} = $num_entries;

    $argsref->{preamble}     = $preamble;
    $argsref->{init_func}    = $init_func;
    $argsref->{bs}           = "$argsref->{base}$argsref->{suffix}_";
    $argsref->{opsarraytype} = $argsref->{trans}->opsarraytype();

    # Invoked as:  ${defines}
    $argsref->{defines} = $argsref->{trans}->defines();

    $argsref->{flag} = $flagref;
    my $self = bless $argsref, $class;
    $self->_iterate_over_ops();

    my ( $op_info, $op_func, $getop );
    $op_info = $op_func = 'NULL';
    $getop = '( int (*)(const char *, int) )NULL';<commit_msg>[lib] Prevented Parrot::Ops2c::Utils from attempting to create lib/Parrot/OpLib directory in its constructor.  A race condition can cause the program to die and the build to fail -- and Parrot::Ops2pm creates this directory as needed only when it's actually necessary anyway (RT #59680, reported by <NAME>).<commit_after># Copyright (C) 2007-2008, The Perl Foundation.
# $Id$
package Parrot::Ops2c::Utils;
use strict;
use warnings;
use lib ("lib/");
use Parrot::OpLib::core;
use Parrot::OpsFile;
use File::Spec;
use IO::File;

=head1 NAME

Parrot::Ops2c::Utils - Methods holding functionality for F<tools/build/ops2c.pl>.

=head1 SYNOPSIS

    $self = Parrot::Ops2c::Utils->new( {
        argv    => [ @ARGV ],
        flag    => Parrot::Ops2c::Auxiliary::getoptions(),
        script  => $0,
    } );

    $c_header_filename = $self->print_c_header_file();

    $c_source_filename = $self->print_c_source_file();

=head1 DESCRIPTION

Parrot::Ops2c::Utils provides methods called by F<tools/build/ops2c.pl>, a
program which is called at various points in the Parrot F<make> process.
The program's function is to create a pair of C header (F<*.h>) and
implementation (F<*.c>) files from the operation definitions found in
one or more F<*.ops> files.

The functionality originally found in F<tools/build/ops2c.pl> has been
extracted into this package's methods in order to support component-focused
testing and future refactoring.

=head1 METHODS

=head2 C<new()>

=over 4

=item * Purpose

Process command-line arguments provided to F<tools/build/ops2c.pl>; construct
and initialize a Parrot::Ops2c::Utils object.

=item * Arguments

Hash reference with the following elements:

    argv        :   reference to @ARGV
    flag        :   hash reference which is the return value of
                    Parrot::Ops2c::Utils::getoptions();
                    hash will have keys such as 'core', 'dynamic' or 'nolines'
    script      :   name of the script to be executed by 'make'
                    (generally, $0 or tools/build/ops2c.pl)

=item * Return Value

Parrot::Ops2c::Utils object.  At this point, the caller is ready to open a
handle to the C-header file and write to it.

=item * Comment

Arguments for the constructor have been selected so as to provide
subsequent methods with all information needed to execute properly and to be
testable.

=back

=cut

sub new {
    my ( $class, $argsref ) = @_;
    unless ( defined $argsref->{flag} ) {
        print STDERR
            "Parrot::Ops2c::Utils::new() requires reference to hash of command-line options: $!";
        return;
    }
    my $flagref = $argsref->{flag};
    my @argv    = @{ $argsref->{argv} };
    $argsref->{script} ||= "tools/build/ops2c.pl";
    unless (@argv) {
        print STDERR "Parrot::Ops2c::Utils::new() requires 'trans' options: $!";
        return;
    }
    my $class_name = shift @argv;
    my %is_allowed = map { $_ => 1 } qw(C CGoto CGP CSwitch CPrederef);
    unless ( $is_allowed{$class_name} ) {
        print STDERR
            "Parrot::Ops2c::Utils::new() requires C, CGoto, CGP, CSwitch and/or  CPrederef: $!";
        return;
    }

    my $trans_class = "Parrot::OpTrans::" . $class_name;
    eval "require $trans_class";
    my $trans = $trans_class->new();

    # Don't yet know how to test the following.
    unless ( defined $trans ) {
        print STDERR "Unable to construct $trans object: $!";
        return;
    }

    my $suffix = $trans->suffix();    # Invoked (sometimes) as ${suffix}

    my $file = $flagref->{core} ? 'core.ops' : shift @argv;
    my $base = $file;    # Invoked (sometimes) as ${base}
    $base =~ s/\.ops$//;
    my $base_ops_stub = $base . q{_ops} . $suffix;
    my $base_ops_h    = $base_ops_stub . q{.h};

    my $incdir  = "include/parrot/oplib";
    my $include = "parrot/oplib/$base_ops_h";
    my $header  = "include/$include";

    # A partially written file will confuse make -j and make error recovery
    # problematic.  create a temp file and rename it afterward.
    my $source = "src/ops/$base_ops_stub.c.temp";

    if ( $flagref->{dynamic} ) {
        $source =~ s!src/ops/!!;
        $header = $base_ops_h;
        $base =~ s!^.*[/\\]!!;
        $include = $base_ops_h;
        $flagref->{dynamic} = 1;
    }

    my $sym_export =
        $flagref->{dynamic}
        ? 'PARROT_DYNEXT_EXPORT'
        : 'PARROT_API';

    my $ops;
    if ( $flagref->{core} ) {
        $ops = _prepare_core(
            {
                file => $file,
                flag => $flagref,
            }
        );
    }
    else {
        $ops = _prepare_non_core(
            {
                file   => $file,
                argv   => [@argv],
                flag   => $flagref,
                script => $argsref->{script},
            }
        );
    }

    my %versions = (
        major => $ops->major_version,
        minor => $ops->minor_version,
        patch => $ops->patch_version,
    );
    my $num_ops     = scalar $ops->ops;
    my $num_entries = $num_ops + 1;       # For trailing NULL
    my $preamble    = _compose_preamble( $file, $argsref->{script} );
    my $init_func   = join '_',
        ( 'Parrot', 'DynOp', $base . $suffix, @versions{qw(major minor patch)}, );

    ##### Populate the object #####
    $argsref->{argv}       = \@argv;
    $argsref->{trans}      = $trans;
    $argsref->{suffix}     = $suffix;
    $argsref->{file}       = $file;
    $argsref->{base}       = $base;
    $argsref->{incdir}     = $incdir;
    $argsref->{include}    = $include;
    $argsref->{header}     = $header;
    $argsref->{source}     = $source;
    $argsref->{sym_export} = $sym_export;

    $argsref->{ops}         = $ops;
    $argsref->{versions}    = \%versions;
    $argsref->{num_ops}     = $num_ops;
    $argsref->{num_entries} = $num_entries;

    $argsref->{preamble}     = $preamble;
    $argsref->{init_func}    = $init_func;
    $argsref->{bs}           = "$argsref->{base}$argsref->{suffix}_";
    $argsref->{opsarraytype} = $argsref->{trans}->opsarraytype();

    # Invoked as:  ${defines}
    $argsref->{defines} = $argsref->{trans}->defines();

    $argsref->{flag} = $flagref;
    my $self = bless $argsref, $class;
    $self->_iterate_over_ops();

    my ( $op_info, $op_func, $getop );
    $op_info = $op_func = 'NULL';
    $getop = '( int (*)(const char *, int) )NULL';
{'fraction_non_alphanumeric': 0.1502474852307201, 'fraction_numerical': 0.006706051413060833, 'mean_word_length': 2.503076062639821, 'pattern_counts': {'":': 0, '<': 22, '<?xml version=': 0, '>': 143, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7287785', 'n_tokens_mistral': 4362, 'n_tokens_neox': 4194, 'n_words': 1112}