Remplacer deux champs en perl

Question

je fichier texte de ce genre

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

Et je un autre fichier

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

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

Lecture du fichier Fichier 1 mise à jour Fichier2 tel que l'Ouput est produit, des idées.

Answer 1

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

Answer 2

Même si je ne suis pas sûr que ce soit ce que vous voulez (voir commentaire). Ceci est un moyen d'obtenir cette sortie:

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 

Answer 3

Essayez ceci:

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; 

Answer 4

Ce code est plus bavard que les autres suggestions affichées ici.

Mais il présente plusieurs avantages:

• . Il est commenté
• Il utilise des handles de fichiers lexicaux et 3 arguments open().
• Les noms de variables sont descriptifs et non fichier1 et fichier2.
• Il est plus souple
  • Facile à ajouter/modifier des champs de remplacement.
  • Facile à traiter plusieurs fichiers de données dans un seul script
  • Facile à appliquer les mêmes données à plusieurs spécifications
• Ne pas diviser ou modifier la spécification, sauf pour effectuer des substitutions.

Bien que cela n'a aucune incidence sur le fait que ce soit un bon concept à utiliser dans la pratique, ce code démontre plusieurs techniques utiles.

• Il génère des fermetures pour gérer le formatage.
• Il utilise la gestion des exceptions atomiques au lieu de l'idiome eval {}; if ($@) { ...handle exception... } défectueux.

---

#!/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' - $@"; 
     } 

    } 
} 

Answer 5

Espérons que cela fonctionnera pour vous.

#! /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; 
    } 
} 

Il est appelé dans l'une des manières suivantes

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 

Si appelé comme ça

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

il lit FILE1 et sorties:

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