Re: Logic trouble parsing a formatted text file into hashes of hashes (of hashes, etc.)

[idnopheq]

Hi, All!

Here is the working code. It needs a lot of love, sure. But here it is for the interested. When I'm done, this might be a module.

#!/usr/bin/perl -wT
#-*-cperl-*-

use strict;
use Data::Dumper;

my (
    $laststate,
    $state,
    $nextstate
   );               # some states

my $key;            # some key
my $value;          # some value
my %NML;            # the master hash
my @hohref = ();    # the hash reference array
my $href   = \%NML; # the master hash reference

open ( SOURCE, "< $ARGV[0]" )
  or die "Couldn't open $ARGV[0] for reading: $!\n";

# There are three possible line beginnings (ignoring whitespace):
#   '(', ':', and ')'
# There are three possible line endings (ignoring whitespace):
#   '(', ')', and neither one

while ( <SOURCE> ) {
 SWITCH: {
    # the first line in the file always starts with '('
    # no other line will match this
    /^\(/       && do {
      $state = $laststate = 0;         # set the state
      $nextstate = 1;                  # elevate the state
      (
       $key,                           # parse the line
       $value
      )                   = ParseLine ( $_ );
      $href->{"filename"} = $key;      # slap it in the master hash re
+ference
      last SWITCH;                     # move on to the next line
    };
    # lines beginning with ':' always have whitespace before it
    # these lines either maintain or elevate the state, never lower th
+e state
    /^\s+:/ && do {
      $laststate          = $state;     # set our old state
      $state              = $nextstate; # set our new state
      # here is where we analyse the line endings
    STATE: {
    # if the line ends with '(', elevate the state
    /\($/ && do {
      $nextstate++;                       # elevate the state
      (
       $key,
       $value
      )               = ParseLine ( $_ ); # parse the line
      push @hohref, $href;                # track our master hash refe
+rence
      if ( exists $$href{$key} ) {        # if we all ready have an an
+on hash ref
        $href = $$href{$key};             #   then reuse it
      }
      elsif ( ! exists $$href{$key} ) { # if we don't have an anon has
+h ref
        $href = $$href{$key} = {};      #   so make a new one
      }
      last STATE;                       # move on
    };
    # if the line ends with ')', maintain the state
    /\)$/ && do {
      (
       $key,
       $value
      )            = ParseLine ( $_ );            # parse the line
      $$href{$key} = array_ref()                  # get an anon array 
+ref
        unless ( ref ( $$href{$key} ) eq 'ARRAY' ); # unless we all re
+ady have an array ref
      push @{ $$href{$key} }, $value;             # add a value to the
+ array ref
      last STATE;                                 # move on
    };
    # other line endings elevate the state
    $nextstate++;                     # elevate the state
    (
     $key,
     $value
    )            = ParseLine ( $_ );  # parse the line
    push @hohref, $href;              # track our master hash referenc
+e
    $href = $$href{$key} = {}         # make a new anon hash ref tied 
+to the master
      unless defined $value;          # unless we have a value
    $href = $$href{$value} = {}       # make a new anon hash ref tied 
+to the master
      if defined $value;              #   with the value as the key
      }
      last SWITCH;                        # next line
    };
    # if the line contains only whitespace and ')', lower the state
     /^\s+\)$/ && do {
       $laststate = $state; # set our old state
       $state--;            # decriment our state
       $nextstate--;        # decrement our next state
       $href = pop @hohref; # remove our old master hash reference
       last SWITCH;         # next line
     };
  }
  # analyse our state
  if ( $state != $laststate ) {
    # we changed state
    print "State Change!\t\t"
      if $ARGV[1];
  }
  print "$laststate\t$state\t$nextstate\n"
    if $ARGV[1];
}

close SOURCE;

# we only care about device files
# other file types are small, so I don't mind reading them in and then
#   discarding them

die "$ARGV[0] is not a device file!\n"
  unless $NML{type}[0] eq "device";

print Dumper \%NML;

sub ParseLine {
  # this could use some severe help
  # strip the leading colon
  $_[0] =~ s/://;
  # strip any quotes
  $_[0] =~ s/\"//g;
  # strip the open parenthesis
  $_[0] =~ s/\(//;
  # strip the closing parenthesis
  $_[0] =~ s/\)$//;
  # strip any whitespace
  $_[0] =~ s/^\s+//;
  $_[0] =~ s/\s+$//;
  # assign both values to variables
  if ( $_[0] =~ / /) {
    return ( split / /, $_[0], 2 ); # split on the white space and ret
+urn two elements 
  }
  else {
    return ( $_[0], undef );        # or return one and undef
  }
}

sub array_ref {
  # return an anonymous array reference
  my @array;
  return \@array;
}