Re: perl parsing

I saw your question about accounting for Brian having more than one of the same device. Here is yet another solution... I didn't use a HoH in my first solution partly because that can be a difficult concept for beginners.

In general I don't recommend approaches that require reading the entire input file into memory and then parsing that memory copy of the file because that often essentially means that the data is being "handled" in some way more than once and can take a lot of memory in the process. Some of the files that I work with can get quite large.

#!/usr/bin/perl
use strict;
use warnings;

my %devices;         # a HOH Hash of Hash {name}{device}
my $current_name;

while ( my $line = <DATA>)
{
   $current_name = $1 if ($line =~ m/^name\s+(\w+)\s+/);
   
   if ( (my $device) = $line =~ /^device\s+([\w\s]+)\n/)
   {
      $device =~ s/[ ]+/ /g;  # multiple-space to a single space
      $devices{$current_name}{$device}++;
   }
}

# print the %devices hash - requires 2 loops

foreach my $name (sort keys %devices)  
{
   print "$name:\n";
   
   foreach my $device (keys %{$devices{$name}})
   {
       print "    $devices{$name}{$device}\t$device\n";   
   }

}

=Prints
Andrew:
    1    ipad 2009
Brian:
    3    ipad 2001
ryan:
    1    ipad 2005
    1    cell 2009
=cut


__DATA__
socks  something
name    Brian
shirt  yellow
socks   black
device ipad  2001
device ipad  2001
device ipad   2001
tag   no
tag    0   
name    Andrew
shirt  orange
socks   black
device ipad 2009
tag   no
tag    0
name    ryan
shirt  blue
socks   black
device ipad  2005
device cell   2009
tag   yes
tag    1
[download]

Comment on Re: perl parsing Download Code

Replies are listed 'Best First'.
Re^2: perl parsing by cbtshare (Monk) on Oct 06, 2017 at 04:47 UTC
Thank I am understanding a bit better now, but I tried your solution , mainly the HOH printing but I am getting error.."Not a Hash reference at line 42 `foreach my $line(keys %hash) { print "$line\n"; ##This works and prints the names foreach my $sit (keys %{$hash{$line}}) #### <--line 42 line throwin +g error { print "$hash{$line}{$sit}\n"; } }` [download]	[reply] [d/l]
Re^3: perl parsing by Marshall (Canon) on Oct 06, 2017 at 05:13 UTC
Show your complete code. I can't tell what your problem is from this snippet. I avoided a HoH (Hash of Hash) in my first code post partly because as I suspected beginners have problems with this. You are proving me right. I suggest that use perhaps my first code that doesn't use any complicated data structures. That will be easier for you to work with? This code took me some minutes to write. It very well could be that it will take you literally hours to understand it. You will not learn if you don't put in the effort.	[reply]
Re^4: perl parsing by cbtshare (Monk) on Oct 06, 2017 at 15:29 UTC
Thank you for taking the time to assist me with this.I want to learn the HOH method, so I will try to use that in my solution with your aid.Using "print Dumper \%hash;" works and te HOH has all the info I need but I can't seem to print it out in a format I want . name device(s) <space> year My entire code is #!/usr/bin/perl use strict; use Data::Dumper; my $infile = 'test_file.txt'; open (IN,'<',$infile) \|\| die ("Could not open $infile : $!"); my $name; my %hash = (); while (<IN>){ s/^\s+\|\s+$//g; # trim leading/trailing spaces my ($col1,$col2,$col3) = split /\s+/,$_,4; if ($col1 eq 'name'){ $name = $col2; } elsif ($col1 eq 'device') { push @{$hash{$name}},$col2,$col3; } else { # skip line } ## ## } close IN; #print Dumper \%hash; foreach my $line (keys %hash) { print "$line\n"; foreach my $sit (keys %{$hash{$line}}) { print "$hash{$line}{$sit}\t$sit"; } } [download] DATA `name Brian device Ipad 2001 device iphone 2000 number 2 name Jason device computer 2011 number 1 name Andrew device ipad 1999 device iphone 1990` [download]	[reply] [d/l] [select]
Re^5: perl parsing by poj (Abbot) on Oct 06, 2017 at 16:59 UTC
Re^6: perl parsing by cbtshare (Monk) on Oct 06, 2017 at 19:11 UTC
Some notes below your chosen depth have not been shown here


Don't ask to ask, just ask
	PerlMonks