Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling

Parsing and modifying CSV files

by ch1 (Novice)
on Sep 24, 2005 at 04:55 UTC ( #494731=perlquestion: print w/replies, xml ) Need Help??

ch1 has asked for the wisdom of the Perl Monks concerning the following question:

I'm new to perl... So, please take it easy on me.
I've two files:

qty,model,size,color,sku 224,128,MD,B,840197082997 0,128,LG,B,840197083000 0,128,XL,B,840197083017

and file2
v_products_model,v_attribute_options_id_1,v_attribute_options_name_1_1 +,v_attribute_values_id_1_1,v_attribute_values_price_1_1,v_attribute_v +alues_name_1_1_1,v_attribute_options_id_2,v_attribute_options_name_2_ +1,v_attribute_values_id_2_1,v_attribute_values_price_2_1,v_attribute_ +values_name_2_1_1,v_attribute_values_id_2_2,v_attribute_values_price_ +2_2,v_attribute_values_name_2_2_1,v_attribute_values_id_2_3,v_attribu +te_values_price_2_3,v_attribute_values_name_2_3_1,v_attribute_values_ +id_2_4,v_attribute_values_price_2_4,v_attribute_values_name_2_4_1 128,1,Download,0,,TEXT,2,Size,2,,SM,3,0,MD,4,0,LG,5,0,XL

If an item from file1 is in-stock, I need to update the field to the left of the size(SM,MD,LG,XL) to zero in file2.

In this example, the desired output would be:

Here is my attempt but it doesn't work:
#!/usr/bin/perl open(I1,"IM.csv") or die "IM.csv: $!"; $_ = <I1>; # read column headings while (<I1>) { # get data chomp; push @lines, $_ ; } open(I2,"Attributes-EP2005Sep23-1907.txt") or die "Attributes-EP2005Se +p23-1907.txt: $!"; $_ = <I2>; # read column headings while (<I2>) { # get data chomp; push @lines2, $_ ; } foreach ( @lines ) { my ($qty,$name,$size,$color,$descript) = split /,/; #print "$qty,$name,$size,$color,$descript\n"; if ($qty <= 0){$qty= ''} else{$qty=0}; foreach ( shift(@lines2) ) { my ($v_products_model,$therest) = split(/,/,$_ +,2); print "$v_products_model\n"; if ($v_products_model eq $name){ my ($begin, $end) = split(/.,$size/,$therest); print "$v_products_model,$begin\n"; } else{push @lines2,$_} }

20050924 Janitored by Corion: Added code tags around data

2005-09-25 Retitled by Arunbear, as per Monastery guidelines
Original title: 'Point me in the right direction'

Replies are listed 'Best First'.
Re: Parsing and modifying CSV files
by Zaxo (Archbishop) on Sep 24, 2005 at 05:00 UTC

    Look at the CSV modules on CPAN. The DBI interfaces may help with intertable issues.

    Please use <code></code> tags for data, too.

    After Compline,

Re: Parsing and modifying CSV files
by poj (Abbot) on Sep 24, 2005 at 09:25 UTC
    The direction I would go is
    1) hold the file1 data in a hash so that you can refer to it without a loop
    2) scan the file2 data, apply the process logic with the file1 data to each record and write out to a new file

Re: Parsing and modifying CSV files
by davidrw (Prior) on Sep 24, 2005 at 13:22 UTC
    Building off of jZed's reply (and your follow-up) to your node Joining two files on common field, you can keep using DBD::CSV and just make this a SQL task:
    #!/usr/bin/perl -w use DBI; use strict; my $dbh = DBI->connect("DBI:CSV:f_dir=/home/turn2sp/tmp") or die "Cannot connect: " . $DBI::errstr; $dbh->{'csv_tables'}->{'file1'} = { 'file' => 'IM.csv'}; $dbh->{'csv_tables'}->{'file2'} = { 'file' => 'Attributes-EP2005Sep2 +3-1907.txt'}; my $sql =<<EOS; UPDATE file2 SET v_attribute_values_price_2_1 = 0 -- is that + the right col?? FROM file1 f1 WHERE file2.v_products_model = f1.model -- are the +se two lines the proper AND file2.v_attribute_values_price_2_1_1 = f1.size -- FK re +lationship ?? AND f1.qty > 0 EOS $dbh->do($sql);
      I've been working on getting DBI and DBD::CSV installed but I've been getting errors for the last couple of days. I'm using solaris 9 and it appears the complier I'm using doesn't play well with the complier perl was complied with.
Re: Parsing and modifying CSV files
by graff (Chancellor) on Sep 24, 2005 at 14:13 UTC
    I'm having trouble following your statement of the problem. After showing samples of the file data, you said:
    If an item from file1 is in-stock, I need to update the field to the left of the size(SM,MD,LG,XL) to zero in file2.
    Okay, this seems to mean that if a line in file1 starts with a non-zero value, some corresponding slot in file2 should be set to zero. But then you add "desired output should be:"
    But, the only difference between this "desired output" and the sample data for file2 is that a couple zeros in the original record have been removed, leaving empty fields next to the sizes that were apparently "out of stock" in file1.

    You didn't say anything above about wanting to delete field contents for "out of stock sizes", and in this example, your stated goal of setting a field to zero looks like a no-op -- the field to the left of "MD" was already zero in the original file2 data, so there should be nothing to do.

    What do you really want?

Re: Parsing and modifying CSV files
by nedals (Deacon) on Sep 24, 2005 at 18:17 UTC

    Step 1: get all your stock data into a hash as suggested by poj

    use strict; use Data::Dumper; my %stock; while (<DATA>) { my ($qty,$model,$size) = split(',',$_); $stock{$model} = [0,0,0,0] unless (exists $stock{$model}); $stock{$model}[0] = $qty if ($size =~ /sm/i); $stock{$model}[1] = $qty if ($size =~ /md/i); $stock{$model}[2] = $qty if ($size =~ /lg/i); $stock{$model}[3] = $qty if ($size =~ /xl/i); } print Dumper(\%stock); __DATA__ 224,128,MD,B,840197082997 0,128,LG,B,840197083000 0,128,XL,B,840197083017 0,12,SM,B,840197082997 15,12,LG,B,840197083000 0,12,XL,B,840197083017 32,8,SM,B,840197082997

    Step 2: Update file2 data

    use strict; ## simulate stock data from above script my %stock; $stock{'128'} = [0,224,0,0]; $stock{'12'} = [0,0,15,0]; $stock{'8'} = [32,0,0,0]; while (<DATA>) { ## file2 my @data = split(',',$_); if (exists $stock{$data[0]}) { my $ary_ref = $stock{$data[0]}; my ($sm,$md,$lg,$xl) = @$ary_ref; $data[9] = $sm unless ($sm); $data[12] = $md unless ($md); $data[15] = $lg unless ($lg); $data[18] = $xl unless ($xl); } print "@data\n"; } # I've assumed you want the 'price' element (??) left alone unless 'qt +y' is zero # in which case set it to zero. __DATA__ 128,1,Download,0,,TEXT,2,Size,2,??,SM,3,??,MD,4,??,LG,5,??,XL 12,1,Download,0,,TEXT,2,Size,2,??,SM,3,??,MD,4,??,LG,5,??,XL 8,1,Download,0,,TEXT,2,Size,2,??,SM,3,??,MD,4,??,LG,5,??,XL
      Wow..... I was way off.
      Here is an update:
      #!/usr/local/bin/perl use strict; my %stock; $stock{'128'} = [0,224,0,0]; $stock{'12'} = [0,0,15,0]; $stock{'8'} = [32,0,0,0]; while (<DATA>) { ## file2 my @data = split(',',$_); if (exists $stock{$data[0]}) { my $ary_ref = $stock{$data[0]}; my ($sm,$md,$lg,$xl) = @$ary_ref; if($sm eq '0'){$sm=''}else{$sm=0}; if($md eq '0'){$md=''}else{$md=0}; if($lg eq '0'){$lg=''}else{$lg=0}; if($xl eq '0'){$xl=''}else{$xl=0}; $data[9] = $sm; $data[12] = $md; $data[15] = $lg; $data[18] = $xl; } print (join(',', @data)); } __DATA__ 128,1,Download,0,,TEXT,2,Size,2,??,SM,3,??,MD,4,??,LG,5,??,XL 12,1,Download,0,,TEXT,2,Size,2,??,SM,3,??,MD,4,??,LG,5,??,XL 8,1,Download,0,,TEXT,2,Size,2,??,SM,3,??,MD,4,??,LG,5,??,XL
      What's scary is.... I Almost understand it.
      Thanks to everyone that replied.
        Another way would be to use the conditional operator inside a loop
        # field number for sizes SM MD LG XL my @fno =(9,12,15,18); while (<DATA>) { ## file2 my @data = split(',',$_); my $ky = $data[0]; if (exists $stock{$ky}) { # check each size for my $sz (0..3){ $data[$fno[$sz]] = ( $stock{$ky}[$sz] eq '0' ) ? '' : '0' ; } } print (join(',', @data)); }
Re: Parsing and modifying CSV files
by Anonymous Monk on Sep 24, 2005 at 07:01 UTC

    I'm new to perl...

    So you should start by adding ues strict and especially use warnings, and fix the errors they display.

      Your right... I need to get into the habit of using "strict and warnings".

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://494731]
Approved by sk
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others musing on the Monastery: (9)
As of 2023-02-07 20:45 GMT
Find Nodes?
    Voting Booth?
    I prefer not to run the latest version of Perl because:

    Results (40 votes). Check out past polls.