view release on metacpan or  search on metacpan

lib/ChordPro/Delegate/Program.pm  view on Meta::CPAN

	unshift( @data, @{ $ctl->{preamble} } );
    }

    if ( is_arrayref($ctl->{postamble}) ) {
	push( @data, @{ $ctl->{postamble} } );
    }

    my $input_data;
    if ( $input eq 'stdin' ) {
	$input_data = join( "\n", @data );
	DEBUG && ::dump( $input_data, as => "Input from $input");
    }
    else {
	if ( $input =~ /^argfile[0N]?$/i ) {
	    my $pos = uc($1 // "N");
	    $input = fn_catfile( $td, "tmp${imgcnt}.in" );
	    if ( $pos eq "0" ) {
		unshift( @cmd, $input );
	    }
	    else {
		push( @cmd, $input );
	    }
	}

	# Store input data in temp file.
	my $fd = fs_open( $input, '>:utf8' );
	print $fd "$_\n" for @data;
	close($fd);
	DEBUG && ::dump( \@data, as => "Input from $input");
    }

    #### Output handling ####

    my $result = $subst->($ctl->{result}) || "stdout";
    DEBUG && warn("Result to $result\n");

    #### Diagnostics handling ####

    my $errors = $subst->($ctl->{errors}) || "stderr";

    #### Run time ####

    unshift( @cmd, $subst->($ctl->{program}) );
    DEBUG && ::dump( \@cmd,  as => "Command:" );

    my $stdout_buf = '';
    my $stderr_buf = '';

    my $status;
    if ( is_wx ) {
	DEBUG && warn("Using Wx::ExecuteStdoutStderr\n");
	( $status, $stdout_buf, $stderr_buf ) =
	  Wx::ExecuteStdoutStderr( "@cmd" );
	# $stdout_buf and $stderr_buf will be strings.
    }
    else {
	DEBUG && warn("Using IPC::Run3::run3\n");
	$stdout_buf = '';
	$stderr_buf = '';
	run3( \@cmd, \$input_data, \$stdout_buf, \$stderr_buf,
	      { binmode_stdout => ':raw',
		return_if_system_error => 1 } );
	# $stdout_buf and $stderr_buf will be strings.
	$status = $? >> 8;
    }

    if ( DEBUG ) {
	::dump( $stdout_buf, as => "Raw result (status: $status)" );
	::dump( $stderr_buf, as => "Raw diagnostics" );
	my $files = fs_find( $td, { filter => qr/^[^.]/ } );
	warn("Temp files:\n") if @$files;
	for ( @$files ) {
	    warn( "  ", fn_catfile( $td, $_->{name} ),
		  ", ", $_->{size}, " bytes\n" );
	}
    }

    my $o = { fail => 'soft' };
    if ( $result eq 'stdout'  ) {
	$result = $stdout_buf;
    }
    else {
	$result = fs_blob( $result, $o );
    }
    if ( $o->{error} ) {
	warn("?Error fetching results: ", $o->{error}, "\n" );
	return;
    }
    DEBUG && ::dump( $result, as => "Result" );

    $o = { fail => 'soft' };
    $errors = fs_load( \$stderr_buf, $o );
    if ( $o->{error} ) {
	warn("?Error fetching diagnostics: ", $o->{error}, "\n" );
	return;
    }

    if ( $errors && @$errors ) {
	warn("Diagnostics from delegate '", $elt->{context}, "':\n");
	warn("$_\n") for @$errors;
    }

    if ( $status ) {
	warn("?Error excuting @cmd (status = $status)\n");
	return;
    }

    if ( !$result ) {
	warn("?Error excuting @cmd (no output?)\n");
	return;
    }

    my $subtype;
    unless ( $subtype = $ctl->{subtype} ) {
	# Get info.
	my $info = detect_image_format(\$result);
	if ( $info->{error} ) {
	    warn("?Error executing @cmd: ", $info->{error}, "\n");
	    return;
	}
	$subtype = $info->{file_ext};