Как удалить строку заголовка во многих файлах и переименовать их с помощью Perl

Question

Мне нужна помощь, чтобы попытаться обработать много маленьких файлов. Мне нужно удалить первую строку (строку даты заголовка), если она существует, а затем переименовать файл q_dat_20110816.out => q_dat_20110816.dat.

Я выяснил, как открыть файл, выполнить сопоставление и распечатать строку, которую мне нужно удалить.

Теперь мне нужно выяснить, как удалить эту строку, а затем вообще переименовать файл.

Как бы вы подошли к этому?

Тестовый код:

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

my $file = '/share/dev/dumps/q_dat_20110816.out';
$file = $ARGV[0] if (defined $ARGV[0]);

open DATA, "< $file" or die "Could not open '$file'\n";
while (my $line = <DATA>) {
        $count++;
        chomp($line);
        if ($line =~m/(Data for Process Q)/) {
                print "GOT THE DATE: --$line\n";
                exit;
        }
}
close DATA;

Пример файла: q_dat_20110816.out

Data for Process Q, for 08/16/2011
Make    Model   Text
a       b       c
d       e       f
g       h       i

Новый файл: q_dat_20110816.dat

Make    Model   Text
a       b       c
d       e       f
g       h       i

Answer 1

Решение «отец-сын» с малым объемом памяти:

use strict;
use warnings;

for my $fni (@ARGV) {
    open(FI, '<', $fni) or die "cant open in '$fni', $!,";
    my $fno = $fni; $fno =~ s/\.out$/.dat/;
    open(FO, '>', $fno) or die "cant open out '$fno', $!,";
    foreach ( <FI> ) {
        print FO unless $. == 1 and /^Data for Process Q/;
    };
    close FO;
    close FI;
    unlink $fni;
};

Не проверено!

Answer 2

Вот один из способов сделать это:

use strict;
use warnings;

my @old_file_names = @ARGV;

for my $f (@old_file_names){
    # Slurp up the lines.
    local @ARGV = ($f);
    my @lines = <>;

    # Drop the line you don't want.
    shift @lines if $lines[0] =~ /^Data for Process Q/;

    # Delete old file.
    unlink $f;

    # Write the new file.
    $f =~ s/\.out$/.dat/;
    open(my $h, '>', $f) or die "$f: $!";
    print $h @lines;
}