Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Shaun E on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

add data to slice of array 1

Status
Not open for further replies.

LinguaFranca

Technical User
Jan 4, 2005
18
NL
How can I add data to an array slice?
To be honest, I am lost. I am basically a linguist trying to automate daily routines around my terminological work. I have got some basic knowledge of Perl but now I am stuck.

Here's what I am after:

File 1 (tab delimited)
Code:
Account Code	format.res
Printing	document_master.frm
Level 2:	widgets.res
Item Group Finder	pickers.res
Document Rule	funcsecmenu.res, procmasters_menu.res

File 2 (database extract)
Code:
23974; []; ; ; ; ; ; CAL; 08.02.2005; ; General Term added by Localisation; ; ; ; ; 23974; [ENG]; item group code; ; ; ; ; ; ; [CAL]: Code assigned to an item group and by means of which the item group is maintained in the system.; ; ; item group; ; ; ; ; confirmed; ; ; CAL; 09.07.2002; ; ; ; ; ; 

15541; []; itemgroupfinder.res; ; ; ; ; CAL; 30.07.2004; ; Procurement; ; ; ; ; 15541; [ENG]; Item Group Finder; ; ; ; ; ; ; ; ; ; ; ; ; ; ; confirmed; ; ; CAL; 26.07.2002; ; ; ; ; ; 

19640; []; appservermsgs.res; ; ; ; ; CAL; 27.07.2004; ; Procurement; ; ; ; ; 19640; [ENG]; Item group not supplied.; ; ; ; ; ; v10.0; ; ; ; ; ; ; ; ; confirmed; ; ; ; ; ; ; ; ; ; 

6892; []; ; ; ; ; ; ; 14.09.2004; ; Financials; codamed.rc; mediamasmain.frm; ; ; 6892; [ENG]; Item Limit; ; ; ; ; ; ; ; ; ; ; ; ; ; ; confirmed; ; ; CAL; 04.07.2002; ; ; ; ; ; 

23975; []; ; ; ; CAL; 31.10.2001; CAL; 08.02.2005; ; General Term added by Localisation; ; ; ; ; 23975; [ENG]; item line value; The line value of the item on the invoice. If you change the quantity or the unit\nprice, the item line value is automatically updated.; ; ; ; ; ; ; ; ; line value; ; ; ; © CODA; confirmed; CAL; 31.10.2001; CAL; 09.07.2002; ; ; ; ; ;


I need to compare the English term from File 1 with the English term of $record[17] from File 2.
If they match, the filename(s) from File 1 need to be added to the filename(s) of $record[2] and sorted uniquely.

Example: Item Group Finder from File 1 matches Item Group Finder from File 2 (record number 15541). The corresponding filename pickers.res from File 1 now needs to be added to $record[2]. The output should be:

15541; []; itemgroupfinder.res, pickers.res; ; ; ; ; CAL; 30.07.2004; ; Procurement; ; ; ; ; 15541; [ENG]; Item Group Finder; ; ; ; ; ; ; ; ; ; ; ; ; ; ; confirmed; ; ; CAL; 26.07.2002; ; ; ; ; ;


Here is the code I have written so far (I must apologize for the poor quality) based on similar scripts I already have. The push line isn't correct and I don't know how to define this correctly.

My script:
Code:
#!usr/bin/perl

use warnings;
use locale;
use strict;

open WEBTERM, "ENG.ANS" or die;
open EXIST, "existing_terms_restored.ans" or die;
open OUTPUT, ">eng.output.ans" or die;

my %eng;
my %eng_from_list;
my %to_be_used;

while (<EXIST>) {
	my ($eng, $filesexist) = split /\t/;
	$eng{$eng}=$filesexist;
	$eng_from_list{$eng}=$eng;
	$to_be_used{$eng} = 1;
	}

close EXIST;

while (<WEBTERM>) {
    
    # grab all []lines and split to identify the slices to work on
    if (/\d+;\s\[\];/) {
        my @record = split(/; /);
        my ($files, $term) = ($record[2], $record[17]);
				my %files;
        map {$files{$_}++} split(', ', $record[2]);
             
      } 
      	
    # compare and add filenames  	
    if (exists $eng_from_list{$term}) {
    		my $eng = $eng_from_list{$term};
    		delete $to_be_used{$eng};
    		push $record[2], my $filesexist;   
        $record[2] = join(', ', sort keys %files);
        print OUTPUT join('; ', @record);
      } else {
      	print OUTPUT;
      	}
				
}
close OUTPUT;
close WEBTERM;

# get all terms from EXIST file that do not match $record[17] 
for (keys %to_be_used) {
    print "NO MATCH:\t$_\t$orig{$_}\n";
}
exit;

 
One possible update:
Code:
#!usr/bin/perl

use warnings;
use locale;
use strict;

open WEBTERM, "ENG.ANS" or die;
open EXIST, "existing_terms_restored.ans" or die;
open OUTPUT, ">eng.output.ans" or die;

my %eng;
my %to_be_used;

while (<EXIST>) {
    my ($eng, $filesexist) = split /\t/;
    $eng{$eng}=$filesexist;
    $to_be_used{$eng} = 1;
}
close EXIST;

while (<WEBTERM>) {
    # grab all []lines and split to identify the slices to work on
    if (/\d+;\s\[\];/) {
        my @record = split(/; /);
        my @files = split(', ', $record[2]);
        # compare and add filenames
        if (exists $eng{$record[17]}) {
            $to_be_used{$record[17]} = 0;
            push @files, split(', ', $eng{$record[17]});
            $record[2] = join(', ', sort @files);
        }
        print OUTPUT join('; ', @record);
    } else {
        print OUTPUT;
    }
}
close OUTPUT;
close WEBTERM;

# get all terms from EXIST file that do not match $record[17]
for (sort keys %to_be_used) {
    if ($to_be_used{$_}) {
        print "NO MATCH:\t$_\t$orig{$_}\n";
    }
}
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top