An example using XML::Twig
poj#!/usr/bin/perl use strict; use autodie; use XML::Twig; use Data::Dumper; $Data::Dumper::Terse = 1; use constant DEBUG => 1; my $base = 'D:/Some/Specific/Folder'; # birthdate lookup table my $oldqr = 'c:/temp/oldqr.txt'; my $lookup = fetch_birthdates($oldqr); print '$lookup=',Dumper $lookup if DEBUG; # process XML files #my @files = glob( $base.'/ToUpload/Staging/*' ); my @files = ('test.xml'); print '@files=',Dumper \@files if DEBUG; for my $file (@files){ add_birthdate($file,$lookup); } # build birthdate lookup table sub fetch_birthdates { my $infile = shift; my %hash = (); my $count = 0; open IN,'<',$infile; # autodie while (<IN>){ ++$count; chomp; # old format #if (my @f = /FirstName(.*)LastName(.*)Email(.*)BirthDate(.*)/i){ # s/^\s+|\s+$//g for @f; # trim spaces my @f = split ';',$_; # new format my $pk = join ';',@f[0..2]; # create lookup key if (exists $hash{$pk}){ die "ERROR Duplicate record in $infile '$pk' line $count\n"; } else { $hash{$pk} = $f[3]; } #} } close IN; print "$count records read from $infile\n"; return \%hash; } # add birth date from lookup # using firstname;name;email as key sub add_birthdate { my ($file,$lookup) = @_; my $twig = XML::Twig->new( pretty_print => 'indented' ); $twig->parsefile( $file ); my ($person) = $twig->findnodes( 'person' ); my $pk = join ";", $person->findvalue('firstname'), $person->findvalue('name'), $person->findvalue('email'); print "Reading $file : "; if (exists $lookup->{$pk}){ my $birthdate = $lookup->{$pk}; my $node = $person->first_child( 'birthdate' ); $node->set_text( $birthdate ); print "$birthdate added for '$pk'\n"; open my $out,'>',$file.'.modified'; #autodie $twig->print($out); close $out; } else { print "ERROR - no birthdate for '$pk'\n"; } }
In reply to Re^2: Matching specific strings (are subs a good idea?)
by poj
in thread Matching specific strings (are subs a good idea?)
by zarath
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |