view release on metacpan or  search on metacpan

lib/App/GenPericmdCompleterScript.pm  view on Meta::CPAN

            '    );', "\n",
            "}\n\n",

            "# display result\n",
            'if    ($shell eq "bash") { print Complete::Bash::format_completion($compres, {word=>$words->[$cword]}) }', "\n",
            'elsif ($shell eq "tcsh") { print Complete::Tcsh::format_completion($compres) }', "\n",
        );

        $code = join "", @res;
    } # END GENERATE CODE

    # pack the modules
    my $packed_code;
    {
        require App::depak;
        require File::Slurper;
        require File::Temp;

        my (undef, $tmp_unpacked_path) = File::Temp::tempfile();
        my (undef, $tmp_packed_path)   = File::Temp::tempfile();

        File::Slurper::write_text($tmp_unpacked_path, $code);

        my %depakargs = (
            include_prereq => [sort keys %used_modules],
            input_file     => $tmp_unpacked_path,
            output_file    => $tmp_packed_path,
            overwrite      => 1,
            trace_method   => 'none',
            pack_method    => 'datapack',
            code_after_shebang => "## no critic: TestingAndDebugging::RequireUseStrict\n", # currently datapack code does not use strict
        );
        if ($args{strip}) {
            $depakargs{stripper} = 1;
            $depakargs{stripper_pod}     = 1;
            $depakargs{stripper_comment} = 1;
            $depakargs{stripper_ws}      = 1;
            $depakargs{stripper_maintain_linum} = 0;
            $depakargs{stripper_log}     = 0;
        } else {
            $depakargs{stripper} = 0;
        }
        my $res = App::depak::depak(%depakargs);
        return $res unless $res->[0] == 200;

        $packed_code = File::Slurper::read_text($tmp_packed_path);
    }

    if ($output_file ne '-') {
        log_trace("Outputing result to %s ...", $output_file);
        if ((-f $output_file) && !$args{overwrite}) {
            return [409, "Output file '$output_file' already exists (please use --overwrite if you want to override)"];
        }
        open my($fh), ">", $output_file
            or return [500, "Can't open '$output_file' for writing: $!"];

        print $fh $packed_code;
        close $fh
            or return [500, "Can't write '$output_file': $!"];

        chmod 0755, $output_file or do {
            log_warn("Can't 'chmod 0755, $output_file': $!");
        };

        my $output_name = $output_file;
        $output_name =~ s!.+[\\/]!!;

        $packed_code = "";
    }

    [200, "OK", $packed_code, {
    }];
}

1;
# ABSTRACT: Generate Perinci::CmdLine completer script

__END__

=pod

=encoding UTF-8

=head1 NAME

App::GenPericmdCompleterScript - Generate Perinci::CmdLine completer script

=head1 VERSION

This document describes version 0.126 of App::GenPericmdCompleterScript (from Perl distribution App-GenPericmdCompleterScript), released on 2023-07-11.

=head1 FUNCTIONS


=head2 gen_pericmd_completer_script

Usage:

 gen_pericmd_completer_script(%args) -> [$status_code, $reason, $payload, \%result_meta]

Generate Perinci::CmdLine completer script.

This function is not exported by default, but exportable.

Arguments ('*' denotes required arguments):

=over 4

=item * B<completion> => I<code>

(No description)

=item * B<default_subcommand> => I<str>

(No description)

=item * B<exclude_package_functions_match> => I<re>

Exclude package functions matching this pattern.

=item * B<get_subcommand_from_arg> => I<int> (default: 1)