модификация сценария в Perl

Question

В настоящее время у меня есть следующий сценарий

#!/usr/bin/env perl 
use strict; 
use warnings; 

my %seen; 

my $header = <> . <>; 
print $header; 

my $last_sequence_number = 0; 

open(my $output, ">", "output.$last_sequence_number.out") or die $!; 
print {$output} $header; 
$seen{$last_sequence_number}++; 

while (<>) { 
    my ($key) = split; 
    next unless $key =~ m/^\d+$/; 
    my $sequence_number = int($key/1000); 
    if (not $sequence_number == $last_sequence_number) { 
     print "Opening new file for $sequence_number\n"; 
     close($output); 
     open($output, ">", "output.$sequence_number.out") or die $!; 
     print {$output} $header unless $seen{$sequence_number}++; 
     $last_sequence_number = $sequence_number; 
    } 
    print {$output} $_; 
} 

скрипт разбивает файл в другие файлы с файлом шаблона 1 файл 2 ... теперь я должен был бы перейти к сценарию другого параметра который позволяет указать префикс для выхода так, если этот дополнительный вход 1, то выход будет

1_file1, 1_file2 .... и так далее .. как я могу это сделать?

Я знаю, что можно было бы использовать что-то вроде

use Getopt::Long; 

?

попробовал этот

#!/usr/bin/env perl 
use strict; 
use warnings; 

my %seen; 

my $header = <> . <>; 
print $header; 
my ($suffix, $filename) = @ARGV; 
open (my $input, "<", $filename) or die $!;         
my $last_sequence_number = 0; 

open(my $output, ">", "output.$last_sequence_number.out") or die $!; 
print {$output} $header; 
$seen{$last_sequence_number}++; 

while (<$input>) { 
    my ($key) = split; 
    next unless $key =~ m/^\d+$/; 
    my $sequence_number = int($key/1000); 
    if (not $sequence_number == $last_sequence_number) { 
     print "Opening new file for $sequence_number\n"; 
     close($output); 
     open($output, ">", "output.$sequence_number.out") or die $!; 
     print {$output} $header unless $seen{$sequence_number}++; 
     $last_sequence_number = $sequence_number; 
    } 
    print {$output} $_; 
} 

, но это не работает. Что не так?

я

No such file or directory at ./spl.pl line 10, <> line 2. 

после заголовка печатается.

Answer 1

Проблема заключается в том, что алмазный оператор <> является частью специальной магической магии.

Он принимает «все имена файлов в командной строке», открывает их и обрабатывает их по порядку.

Для того, чтобы делать то, что вы пытаетесь сделать:

my ($suffix, $filename) = @ARGV; 
open (my $input, "<", $filename) or die $!; 

Затем вы можете изменить время цикла для:

while (<$input>) { 

и изменить имя выходного файла в соответствии с вашими желаниями. Ключевым моментом является то, что в этом месте будет только одно имя файла - первый аргумент arg - суффикс, второй - имя.

Вы могли бы, возможно, расширить это с:

my ($suffix, @names) = @ARGV; 

А затем запустить цикл Еогеасп:

foreach my $filename (@names) { 
    open .... #etc 

Answer 2

Как говорит Sobrique, ваша проблема в том, магическая природа <>. Но я не думаю, что это так же сложно, как он думает.

Дело в том, что <> рассматривает текущий значение @ARGV. Таким образом, вы можете добавить другие аргументы командной строки, пока вы убедитесь, что вы удалили их с @ARGV, прежде чем использовать <> в первый раз.

Так изменить код так, что он начинает так:

my %seen; 

my $prefix = shift; 

my $header = <> . <>; 

Вы можете назвать свою программу так:

$ your_program.pl prefix_goes_here list of file names... 

Все остальное должно работать так же, как это в настоящее время делает, но у вас есть префикс, хранящийся в $prefix, чтобы вы могли использовать его в своих операциях print.

Надеюсь, это то, что вы хотели. Ваш вопрос не особенно ясен.

Answer 3

Я бы сделал что-то вроде этого.

#!/usr/bin/env perl 
use strict; 
use warnings; 
use autodie; 
use Getopt::Long qw(:config bundling); 
use Pod::Usage; 

{ 
    my $man   = 0; 
    my $help   = 0; 
    my $verbose  = 0; 
    my $prefix  = ''; 
    my $suffix  = ''; 
    my $header_lines = 2; 
    my $bunch_size = 1000; 

    GetOptions(
     'help|?'     => \$help, 
     'man'     => \$man, 
     'verbose|v+'    => \$verbose, 
     'prefix|p=s'    => \$prefix, 
     'suffix|s=s'    => \$suffix, 
     'header|h=i'    => \$header_lines, 
     'bunch|batch|bucket|b=i' => \$bunch_size 
    ) or pod2usage(2); 
    pod2usage(1) if $help; 
    pod2usage(-exitval => 0, -verbose => 2) if $man; 
    pod2usage(
     -exitval => 3, 
     -message => "Headers lines can't be negative number" 
    ) if $header_lines < 0; 
    pod2usage(
     -exitval => 4, 
     -message => "Bunch size has to be positive" 
    ) unless $bunch_size > 0; 

    my $header = ''; 
    $header .= <> for 1 .. $header_lines; 

    my %seen; 
    my $current_output_number = -1; 

    sub key2output { int(shift()/$bunch_size) } 

    sub set_output { 
     my $output_number = shift; 
     if ($output_number != $current_output_number) { 
      my $seen = $seen{$output_number}++; 
      printf STDOUT "Opening %sfile for %d\n", $seen ? '' : 'new ', 
       $output_number 
       if $verbose; 
      open my $fh, $seen ? '>>' : '>', 
       $prefix . $output_number . $suffix; 
      select $fh; 
      print $header unless $seen; 
      $current_output_number = $output_number; 
     } 
    } 
} 

while (<>) { 
    my ($key) = /^(\d+)\s/; 
    next unless defined $key; 
    set_output(key2output($key)); 
    print; 
} 

__END__ 

=head1 NAME 

code.pl - splits file by first number by thousands 

=head1 SYNOPSIS 

code.pl [options] [file ...] 

Options: 
    --help   brief help message 
    --man    full documentation 
    --prefix   output filename prefix 
    --suffix   outpit filename suffix 
    --header   number of header lines (default: 2) 

=head1 OPTIONS 

=over 8 

=item B<--help> 

Print a brief help message and exits. 

=item B<--man> 

Prints the manual page and exits. 

=back 

=head1 DESCRIPTION 

B<This program> will read the given input file(s) and do something 
useful with the contents thereof. 

=cut 

Просто завершите документацию, и вы можете отправить ее своим коллегам.