Re^6: how to properly handle the closing of pipe? read from the pipe unzip-c and get out before

[mishin]

in reply to Re^5: how to properly handle the closing of pipe? read from the pipe unzip-c and get out before
in thread how to properly handle the closing of pipe? read from the pipe unzip-c and get out before

Finishing variant,many thanks, perlcritic brutal - Ok

######################################################################
+########
#      $URL: http://mishin.narod.ru $
#     $Date: 2011-02-17 20:53:20 +0300 (Mon, 14 Feb 2011) $
#   $Author: mishin nikolay $
# $Revision: 1.02 $
#   $Source: Pipe_quest.pl $
#   $Description: script read data from zip file $
######################################################################
+########
package # hide from indexer
  Pipe_quest;

use 5.006;
use strict;
use warnings;
use English qw(-no_match_vars);
use Carp;

our $VERSION = '0.01';

use Readonly;

Readonly my $STRING_NUMBER2EXIT => 100_000;
my $EMPTY    = q{};
my $ret      = $EMPTY;
my $file_src = 'test.zip';
my $out_file = 'out.xml';
my $file     = get_name_from_zip($file_src);

{
    local $SIG{PIPE} = 'IGNORE';    #Ignore broken pipe errors
    open my $FH, q{-|}, "unzip -p $file_src $file"
      or croak "bah unzip -p $file_src $file";
    $ret = search_trade_by_index( $FH, $out_file, $STRING_NUMBER2EXIT 
+);
    close $FH
      or croak
      "unable to close: unzip -p $file_src $file $ERRNO";  # $! $OS_ER
+ROR $ERRNO
}

sub search_trade_by_index {
    my ( $fh, $xml_filename, $quit_str ) = @_;
    my @xml_out = ();
    my $xml_out = $EMPTY;
  LINE: while ( my $line = <$fh> ) {
        push @xml_out, $line;
        if ( $INPUT_LINE_NUMBER eq $quit_str ) {
            $xml_out = join $EMPTY, @xml_out;
            $ret = file_write( $xml_filename, $xml_out );
            last LINE;
        }
    }
    return 1;
}

sub get_name_from_zip {
    my ($loc_file_src) = @_;
    my ( $ca, $cb, $cc, $loc_file );
    my @result = readpipe "unzip -l $loc_file_src";
    foreach (@result) {
        if (/txt$/xsm) {
            ( $ca, $cb, $cc, $loc_file ) = split;
        }
    }
    return $loc_file;
}

sub file_write {
    my ( $wfile, $message ) = @_;
    open my $fh, q{>}, "$wfile" or croak "unable to open:$wfile $ERRNO
+";
    $ret = print {$fh} $message;
    close $fh or croak "unable to close: $wfile $ERRNO";
    return 1;
}
1;