Замените два поля в Perl - PullRequest
1 голос
/ 14 мая 2009

У меня есть текстовый файл такого типа

File 1
-------
ABC 123
DEF 456
GHI 111

И у меня есть другой файл

File 2
------
stringaa ttt stringbb yyy

Ouput
-----
stringaa ABC stringbb 123
stringaa DEF stringbb 456
stringaa GHI stringbb 111

Чтение файла File 1, обновление File2 таким образом, что производится Ouput, любые идеи

Ответы [ 5 ]

1 голос
/ 16 мая 2009

Этот код является более подробным, чем другие предложения, размещенные здесь.

Но у него есть несколько преимуществ:

  • Комментируется.
  • Используются лексические дескрипторы файлов и 3 аргумента open ().
  • Имена переменных носят описательный характер, а не file1 и file2.
  • Это более гибкий
    • Легко добавлять / изменять поля замены.
    • Простая обработка нескольких файлов данных в одном скрипте
    • Легко применять одни и те же данные к нескольким спецификациям
  • Не разделяет и не изменяет спецификацию, кроме как для замены.

Хотя это не имеет никакого отношения к тому, является ли этот дизайн удачным для практического использования, этот код демонстрирует несколько полезных методов.

  • Он генерирует замыкания для обработки форматирования.
  • Используется атомарная обработка исключений вместо некорректной eval {}; if ($@) { ...handle exception... } идиомы.

#!/usr/bin/perl

use strict;
use warnings;

# Supply test data - remove from real code.
my $test_data = <<'END';
ABC 123
DEF 456
GHI 111
JKL
MNO 999 888
END

my $test_spec = <<'END';
stringaa ttt stringbb yyy
END

# Use test data if no files specified.
# works because you can open() a scalar ref as a file.
# remove from real code -> should display usage information and die.
my $file_data = shift @ARGV || \$test_data;
my $file_spec = shift @ARGV || \$test_spec;

# List of tokens to replace in spec file.
# Real code should probably take list of tokens as argument.
my @replace = qw( ttt yyy );

my $spec   = Read_Spec_From_File( $file_spec );
my $format = Make_Formatter( $spec, @replace );
Print_Formatted_Data( $format, $file_data );

exit;

# -----------------------------------------------------------


# Read a specification from a file.
sub Read_Spec_From_File {
    my $file = shift;   # path to file

    open( my $fh, '<', $file )
        or die "Unable to open format specification file '$file' - $!\n";

    my $spec;

    local $_;
    while( <$fh> ) {

        die "Specification file format error - too many lines.\n"
            if defined $spec;

        $spec = $_;
    }

    die "Specification file format error - no specification.\n"
        unless defined $spec;


    return $spec;
}

# Create a formatting function that can be used to apply data to a
# specification.
#
# Formatting function takes a list of data values to apply to replacement
# tokens.
#
# Given spec 'word aaa blah bbb cheese ccc bar aaa'
# With token list is 'aaa', 'bbb', 'ccc',
# and data 111, 222, 333
# The result is 'word 111 blah 222 cheese 333 bar 111'
# 
sub Make_Formatter {
    my $spec = shift;
    my @replacement_tokens = @_;

    # formatter expects a list of data values.
    return sub {
        my $new_line = $spec;

        die "More data than tokens\n" 
            if @_ > @replacement_tokens;

        for ( 0..$#replacement_tokens ) {

            my $token = $replacement_tokens[$_];
            my $value = $_[$_];


            if ( not defined $value ) {
                die "No data for '$token'\n"; 
                $value = '<UNDEF>';
            }

            $new_line =~ s/$token/$value/g;

        }

        return $new_line;
    };
}

# Process a data file and print a set of formatted data.
sub Print_Formatted_Data {
    my $format    = shift; # Formatter function
    my $data_file = shift; # Path to data file.

    open( my $data_fh, '<', $data_file )
        or die "Unable to open data file '$data_file' - $!\n";

    while ( my $raw_data = <$data_fh> ) { 
        my @data_set  = split /\s+/, $raw_data;

        eval { 
            my $formatted = $format->(@data_set);

            print $formatted;
            1;
        }
        or do {
            warn "Error processing line $. of '$data_file' - $@";
        }

    }
}
1 голос
/ 14 мая 2009

Даже если я не уверен, что это то, что вы хотите (см. Комментарий). Это способ получить этот вывод:

vinko@parrot:~$ more file1.txt
ABC 123
DEF 456
GHI 111
vinko@parrot:~$ more file2.txt
stringaa ttt stringbb yyy
vinko@parrot:~$ more concat.pl
use strict;
use warnings;

open (F1,"<",file1.txt) or die $!;
open (F2,"<",file2.txt) or die $!;

while (<F2>) {
        my ($field1, $field2, $field3, $field4) = split /\s/;
        while (<F1>) {
                my ($innerfield1, $innerfield2) = split /\s/;
                print "$field1 $innerfield1 $field3 $innerfield2\n";
        }
}
close F1;
close F2;
vinko@parrot:~$ perl concat.pl
stringaa ABC stringbb 123
stringaa DEF stringbb 456
stringaa GHI stringbb 111
1 голос
/ 14 мая 2009

Попробуйте это:

my $file1 = shift @ARGV;
my $file2 = shift @ARGV;

open F2, $file2 or die $!;
chomp(my $template = <F2>);
my @fields = split/\s+/,$template;
close F2;

open F1, $file1 or die $!;
while (<F1>) {
    chomp;
    ($val1,$val2) = split/\s+/;
    print join("\t",$fields[0],$val1,$fields[2],$val2),"\n";

}
close F1;
1 голос
/ 14 мая 2009
use strict;
use warnings;

my ($file1, $file2) = @ARGV;
open F, $file2 or die "Can't open $file2: $!\n";
$_ = <F>; # File2 should have one line only
close F;

die "$file2 in unexpected format for second file '$_'\n" unless /(\w+)\s\w+\s(\w+)/;
my ($stra, $strb) = ($1, $2);

open F, $file1 or die "Can't open $file1: $!\n";
while(<F>)
{
    s/(\w+)\s(\d+)/$stra $1 $strb $2/;
        print;
}
0 голосов
/ 23 июля 2009

Надеюсь, это сработает для вас.

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

my($in_file,$filter,$out_file);

if( @ARGV == 0 ){
  die "Must have filter at least\n";
}elsif( @ARGV == 1 ){
  ($filter) = @ARGV;
}elsif( @ARGV >= 2 ){
  ($in_file,$filter) = @ARGV;
}else{
  ($in_file,$filter,$out_file) = @ARGV;
}


{
  # autodie checks open() for errors
  # so we don't have to
  my($IN,$OUT);
  if( defined $in_file ){
    open $IN,  '<', $in_file;
  }else{
    $IN = *STDIN{IO};
  }
  if( defined $out_file ){
    open $OUT, '>', $out_file;
  }else{
    $OUT = *STDOUT{IO};
  }

  ProcessFiles($IN,$OUT,$filter);

  close $OUT;
  close $IN;
}

sub ProcessFilter{
  my($filter,$str) = @_;

  my @elem = grep {$_} split ' ', $str;

  $filter =~ s/\$(?|(?:{(\d+)})|(\d+))/ $elem[$1-1] /eg;

  return $filter;
}
sub ProcessFiles{
  my($IN,$OUT,$filter) = @_;

  while( my $line = <$IN> ){
    chomp $line;
    next unless $line;
    $line = ProcessFilter($filter,$line);
    say {$OUT} $line;
  }
}

Это называется одним из следующих способов

perl program.pl <input-file> 'filter string' <output-file>
perl program.pl <input-file> 'filter string' # sends to STDOUT
perl program.pl 'filter string' # recieves from STDIN, sends to STDOUT

Если называется так

program.pl FILE1 'stringaa ${1} stringbb $2'

читает FILE1 и выводит:

stringaa ABC stringbb 123
stringaa DEF stringbb 456
stringaa GHI stringbb 111
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...