Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Perl: Системное программирование > как правильно обработать закрытие pipe?


Автор: mishnik 29.3.2011, 15:08
Что делает скрипт: читает из зипа нужный кусок и выходит из цикла чтения раньше, чтобы сэкономить время
P.S. :все происходит на продуктиве 
$showrev
Release: 5.10
Kernel architecture: sun4u
Application architecture: sparc
Hardware provider: Sun_Microsystems
Kernel version: SunOS 5.10 Generic_142900-09

ставить доплнительные модули perl я не могу (типа Archive::Zip,IO::Compress::Zip)

Есть код на perl, который идеально проходит через perlclitic по Brutal (report all violation), но
при выполнении perl pipe_quest.pl
unable to close: unzip -c test.zip utp.live.stp.published.messages.txt  at pipe_quest.pl line 29

формирует файл, который нужно, но выдает ошибку,
как обработать эту ошибку правильно, чтобы ее не было? 

если close $FH; вообще не обрабатывать, то код не проходит по perlcritic 
да и это может вызвать утечку памяти, если файл большой (>10Gb) и закрыть пайп все-таки нужно будет, контролируя эту утечку.

Код

#!/usr/bin/perl
##############################################################################
#      $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 $
##############################################################################
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 => 1000;
my $EMPTY    = q{};
my $ret      = $EMPTY;
my $file_src = 'test.zip';
my $out_file = 'out.xml';
my $file     = get_name_from_zip($file_src);
open my $FH, q{-|}, "unzip -c $file_src $file"
  or croak "bah $file_src";
$ret = search_trade_by_index( $FH, $out_file, $STRING_NUMBER2EXIT );
close $FH or croak "unable to close: unzip -c $file_src $file $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;
}

Автор: Pfailed 30.3.2011, 21:35
Почему не может закрыть? Потому что на том конце еще не завершился процесс? Тогда завершить этот процесс принудительно через kill.

Автор: mishnik 5.4.2011, 12:08
Цитата(Pfailed @ 30.3.2011,  21:35)
Почему не может закрыть? Потому что на том конце еще не завершился процесс? Тогда завершить этот процесс принудительно через kill.

как-то через kill - некрасиво, он сам доожен завершиться по brokeen pipe,мне бы только хотелось понять как поймать этот $SIG{'PIPE'}
и обработать его, чтобы все было под контролем

Автор: Pfailed 5.4.2011, 19:34
SIGPIPE вам не надо ловить он не в вашей программе происходит.
Ситуация такая:
Вы закрываете канал. Анзипу приходит SIGPIPE и он завершается. Естественно завершается с ненулевым кодом возврата. В документации по close() сказано, что если подпроцесс завершается с ненулевым кодом, то close() возвратит ложное значение. Имеет смысл игнорировать значение, возврашаемое close в данном случае.

Автор: mishnik 7.4.2011, 15:06
Цитата(Pfailed @ 5.4.2011,  19:34)
SIGPIPE вам не надо ловить он не в вашей программе происходит.
Ситуация такая:
Вы закрываете канал. Анзипу приходит SIGPIPE и он завершается. Естественно завершается с ненулевым кодом возврата. В документации по close() сказано, что если подпроцесс завершается с ненулевым кодом, то close() возвратит ложное значение. Имеет смысл игнорировать значение, возврашаемое close в данном случае.

хотя это не совсем то, что мне хотелось, но получается так
Код

##############################################################################
#      $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 $
##############################################################################
#http://www.fastcgi.com/drupal/node/5?q=node/11
#http://www.rocketaware.com/perl/perlvar/_SIG_expr_.htm
#http://docstore.mik.ua/orelly/perl/prog/ch08_01.htm -debug
#http://ods.com.ua/win/eng/program/Perl5Unleashed/ch14.phtml
#http://ods.com.ua/win/eng/program/Perl5Unleashed/ch14.phtml
#http://taw.chaosforge.org/perl/perl-wyklad10.html
#http://perl.find-info.ru/perl/015/socket.htm
#http://www.fnal.gov/docs/products/perl/pod.new/5.00503/pod/perlvar.html
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 => 100000;
my $EMPTY    = q{};
my $ret      = $EMPTY;
my $file_src = 'test.zip';
my $out_file = 'out.xml';
my $file     = get_name_from_zip($file_src);

$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_ERROR $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;
}



пускай будет так, хотя и душа не лежит к этому решению

Автор: mishnik 7.4.2011, 15:26
как говориться итоговый вариант - finish for today Pipe_quest.pl:
Код

##############################################################################
#      $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_ERROR $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;


проходит perlcritic по brutal

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)