perl - 进程生成具有重复结果的文件

Question

该文件QUERIES_LIST具有由 生成的重复结果query_control。问题可能出在代码的这部分吗？

my $ok = 0;

llog($DEBUG, 'begin step=[' . ( defined $step ? $step : 'N/A' ) . ']');

if ( defined $step and $step eq 'CTL' ) {

    hlog($INFO, 'begin CTL step');

    my $MAX_PROCESS_TO_USE;
    my $queries_to_execute = [];
    my @team               = ();

    $SIG{CHLD} = \&zombies_killer;

    $DICTIONARY->{LIST_REQUETE}   = $CONFIG->{ExportFiles}->{QUERIES_LIST};
    $DICTIONARY->{separator_req}  = $CONFIG->{CTLQueriesSeparators}->{separator_req};
    $DICTIONARY->{separator_ctl}  = $CONFIG->{CTLQueriesSeparators}->{separator_ctl};
    $DICTIONARY->{ALL_QUERY_CTRL} = $CONFIG->{ExportFiles}->{QUERY_CTRL_GET};

    my $sr;
    my $msgs;

    if ( can_we_proceed_now($CONFIG) ) {

        ( $ok, $sr, $msgs ) = ExecScripts(
            Scripts  => [ $CONFIG->{BTEQScripts}->{query_control} ],
            Messages => [ 'FILE=Get control queries listEXEC=', ],
            Files    => [ $CONFIG->{ExportFiles}->{QUERIES_LIST} ],
            NoExec   => [1],
        );

        llog($DEBUG, "CTL1 ok=[$ok] SR=[" . Dumper( $sr ) . '] msg=[' . Dumper( $msgs ) . ']');

        if ( ! $ok ) {
            llog($INFO, 'an error occured previously, abort');
            return CTL_FAIL_GET_CTRL_QUERIES;
        }

        if ( ! -z $CONFIG->{ExportFiles}->{QUERIES_LIST} ) {
            $ok = ctl_clean_exported_file(
                INPUT_FILE  => $CONFIG->{ExportFiles}->{QUERIES_LIST},
                OUTPUT_FILE => $CONFIG->{ExportFiles}->{QUERIES_LIST} . '.tmp',
            );

标签： perlduplicates

Answer 1

我正在检查一个新脚本，该脚本在 arg 中执行脚本，结果在 arg 文件中，可能是原因：

函数是这样调用的

($ok, $sr, $msgs) = ExecScripts
                (Scripts =>
                [ 
                    $CONFIG->{BTEQScripts}->{query_control}
                ],
                Messages =>
                [
                    'FILE=Get control queries listEXEC=',
                ],
                Files =>
                [
                    $CONFIG->{ExportFiles}->{QUERIES_LIST}
                ],
                NoExec => [ 1 ],
                );

sub ExecScripts
{
    llog ($DEBUG, 'begin, args = ['.Dumper (\@_).']');

    my %args =
    (
        Scripts => [],
        Messages => [],
        Files => undef,
        Cache => undef,
        NoExec => undef,
        @_
    );

    my $ok = 0;
    my $scripts_results = [];
    my $monitor_messages = [];

    my $exs_curr_step = launcher_step ();

    #if ($exs_curr_step eq 'CHK')
    #{

        # for some reason, error reference define CHK step as FVT, the consistency !
        #$exs_curr_step = 'FVT';
    #}


    if (defined $args{Scripts} and ref $args{Scripts} eq 'ARRAY')
    {
        if ( $#{$args{Scripts}} > -1 )
        {
            my $temp_script_file = [];
            my $script_idx = 0;

ESCRIPTLOOP:
            for my $script ( @{$args{Scripts}} )
            {
                llog ($DEBUG, "process script [$script]");

                my $subvarok;
                my $skip_substitute = 0;

                $temp_script_file->[$script_idx] = File::Spec->catfile ($CONFIG->{Folders}->{TEMPORARY_DIRECTORY}, basename ($script) );
                add_to_trash ( [ $temp_script_file->[$script_idx] ] );

                if (defined $args{Cache} and ref $args{Cache} eq 'ARRAY' and $args{Cache}->[$script_idx])
                {
                    llog ($DEBUG, "S[$script_idx] Cache set, check file");

                    if (-e $temp_script_file->[$script_idx])
                    {
                        llog ($DEBUG, "S[$script_idx] file [".$temp_script_file->[$script_idx].'] exists');
                        $skip_substitute = 1;
                    }
                    else
                    {
                        llog ($DEBUG, "S[$script_idx] does not exists, do variables susbtitution step");
                    }
                }

                unless ($skip_substitute)
                {
                    if (-e $temp_script_file->[$script_idx])
                    {
                        unlink ( $temp_script_file->[$script_idx] );
                    }

                    $subvarok = substitute_variables_values_from_conf_in_bteq_script
                    (
                        BTEQScript => $script,
                        OutputFile => $temp_script_file->[$script_idx],
                        Dictionary => $DICTIONARY,
                        StripComments => 1,
                    );

                    llog ($DEBUG, "[$script_idx]($script) SVs=[$subvarok]");

                    if (!$subvarok)
                    {
                        llog ($INFO, "Error in script [$script] (idx=[$script_idx]), see above log for more info");
                    }
                }
                else
                {
                    $subvarok = 1;
                }

                if (!-e $temp_script_file->[$script_idx])
                {
                    llog ($ERROR, "S[$script_idx] script [".$temp_script_file->[$script_idx].'] does not exists, abort current step');
                    return 0;
                }               

                if ($subvarok)
                {
                    my $message_before_export = '';
                    my $message_before_exec = '';

                    if (defined $args{Messages} and ref $args{Messages} eq 'ARRAY' and defined $args{Messages}->[$script_idx])
                    {
                        if ($args{Messages}->[$script_idx] =~ /FILE=(.*)EXEC=(.*)/)
                        {
                            $message_before_export = $1;
                            $message_before_exec = $2;
                        }
                        else
                        {
                            $message_before_export = $args{Messages}->[$script_idx];
                        }

                        hlog ($INFO, $message_before_export);
                    }

                    my $script_to_execute;

                    if (defined $args{Files} and ref $args{Files} eq 'ARRAY' and defined $args{Files}->[$script_idx])
                    {
                        llog ($DEBUG, "[$script_idx] Files args defined, use ExecBTEQGetFile");
                        my $getfile_ok = ExecBTEQGetFile 
                        (
                            Script => $temp_script_file->[$script_idx],
                            OutputFile => $args{Files}->[$script_idx],
                            Sync => 1,
                        );

                        llog ($DEBUG, "[$script_idx] GetFile result=[$getfile_ok]");

                        my $msg = check_monitor_messages ($exs_curr_step);

                        if (defined $msg)
                        {
                            if ($msg =~ /^EXIT-/)
                            {
                                $monitor_termination_message_received = 1;
                                return MONITOR_IS_GONE;
                            }

                            push @{$monitor_messages}, $msg;
                        }

                        if ($args{NoExec} and ref $args{NoExec} eq 'ARRAY' and $args{NoExec}->[$script_idx])
                        {
                            llog ($INFO, 'DO NOT execute file got earlier');
                            next ESCRIPTLOOP;
                        }

                        $script_to_execute = $args{Files}->[$script_idx];
                        #check if script file exists and not empty
                        # empty may or may not be an error !

                        llog ($DEBUG, "GetFile exec: execute script [$script_to_execute]");

                        if (-e $script_to_execute and -z _)
                        {
                            llog ($WARN, 'export file is empty, skip script execution');
                            #$ok = 1; #?? needed, better, latter check will not return fail status
                            # BUT: should we consider empty file as not an error ALWAYS ?
                            $ok = $script_idx;

                            next ESCRIPTLOOP;
                        }

                        if ($message_before_exec)
                        {
                            hlog ($INFO, $message_before_exec);
                        }
                    }
                    else
                    {
                        $script_to_execute = $temp_script_file->[$script_idx];
                        llog ($DEBUG, "Std exec: execute script [$script_to_execute]");
                    }

                    #flags = ret2
                    my ($exec_ok, $script_res) = ExecBTEQ 
                    ( 
                        Scripts => [ $script_to_execute ]
                    );

                    llog ($DEBUG, "ExecBTEQ ret=[$exec_ok] SR=[".Dumper ($script_res).']');
                    hlog ($DEBUG, "Script[$script_idx] => $exec_ok");

                    if (defined $script_res and ref $script_res eq 'ARRAY' and $#{$script_res} > -1)
                    {
                        map
                        {
                            if ($_)
                            {
                                hlog ($ERROR, 'ERROR '.$_);
                            }
                        }
                        @{$script_res};
                    }

                    my $msg = check_monitor_messages ($exs_curr_step);

                    if (defined $msg)
                    {
                        if ($msg =~ /^EXIT-/)
                        {
                            $monitor_termination_message_received = 1;
                            return MONITOR_IS_GONE;
                        }

                        push @{$monitor_messages}, $msg;
                    }

                    #abort
                    if (!$exec_ok)
                    {
                        llog ($ERROR, 'An error occured when running, or trying to run, previous script, end here now');

                        #shall we continue anyway ?
                        return 0;
                    }

                    if ($script_res->[0])
                    {
                        map
                        {
                            my $msg = $_;

                            if ($_ =~ /^\d+$/)
                            {
                                $msg = 'return code: '.$_;
                            }

                            hlog ($ERROR, $script.' : '.$msg );
                        }
                        split /;/, $script_res->[0];
                    }

                    if (defined $script_res->[$script_idx])
                    {
                        llog ($INFO, 'get a return code from a script, which usually means Bteq process is gone, and something failed');

                        if ($exec_ok)
                        {
                            llog ($DEBUG, 'ExecBTEQ does not return an error, consider this as a functional error');
                            $ok += $exec_ok;
                        }
                    }
                    else
                    {
                        $ok += $exec_ok;
                    }

                    $scripts_results->[$script_idx] = $script_res->[$script_idx];
                }

                $script_idx++;
            }

            #not go here !

            # return 1 if no error occured previously, ie all scripts runs well
            llog ($DEBUG, "previous ok=[$ok] sidx=[$script_idx] final ok = 1 if they're equals");
            $ok = ($ok == $script_idx);
        }
        else
        {
            llog ($WARN, 'no script provided, nothing to do');
        }
    }
    else
    {
        llog ($ERROR, 'parameter error');
    }

    llog ($DEBUG, 'end ok=['.$ok.']');

    ($ok, $scripts_results, $monitor_messages);
}