#! usr/bin/perl
# Compiler directives and Includes
use strict;
use warnings;
use diagnostics;
use Data::Dumper;

# Global declarations;

# Constants and pragmas
use constant MINSTATLEN03 => scalar 4;

#main()
{
    my $db01    = '';
    my %statgrp = ();
    my $table   = 'pgmsvcs.statgrp_ld';
    my $rptfh   = '';
    my $rtncd   = 0;
    
    $rtncd = FindStatGrps(\%statgrp, $table);
    exit;
} #end main()

sub FindStatGrps{
my $statgrp = shift;
my $table   = shift;

my $rtncd     = 0;
my @statlst01 = ();

push @statlst01, [ split /\s+/ ] while(<DATA>);

my %grplst = ();
my %placedstats = ();

STATUTE: foreach my $idx (0..$#statlst01){

  my $statute = $statlst01[$idx][0].$statlst01[$idx][1];
  
  next STATUTE if(exists($placedstats{$statute})); # skip if statute
                                                   # already classified

  GROUP: for my $i (MINSTATLEN03..length($statlst01[$idx][0])){
  
    next if substr($statute,$i-1,1) eq '.'; # skip if subgrp ends on
                                            # a subfield seperator (.)
    my $grpformatch = substr($statute,0,$i);
    my $levdeg = $statlst01[$idx][1];

                                            # initialize category bins
    my %srsgrp = (CM=>[],NCM=>[] ,SO=>[],ROB=>[],OTH=>[],BURG=>[],
                  TFF=>[],WC=>[],PROP=>[],DRG=>[],MISD=>[],OTH=>[],
                  DNC=>[]);

    my $j = $idx;
    do{                     # load indiv stats into respective bins
                            # does indiv stat belong to group?
      if($statlst01[$j]->[0] =~ /^$grpformatch/){
        if($statlst01[$j]->[1] eq $levdeg){
          push @{$srsgrp{$statlst01[$j]->[2]}}, $statlst01[$j];
        }
      }else{                # if statute does not match, stop looking
          $j = @statlst01;  # since list is ordered
      }
    }while(++$j < @statlst01);
                                                        
                            # check if more than one bin is occupied
    my $nrgrps = 0;
    (scalar @{$srsgrp{$_}} > 0) && $nrgrps++ foreach (keys %srsgrp);

    if($nrgrps > 1){        # 2 or more bins are occupied
      next GROUP;           # try inclrease group and try again
    }
    elsif($nrgrps == 1){    # only 1 bin occupied -- good
      my $srscat = undef;                    # determin bin name
      ($srscat || ((scalar @{$srsgrp{$_}} > 0) && ($srscat = $_))) 
                                               foreach (keys %srsgrp); 

      my $grp = $grpformatch.$levdeg;        # define group key
      $statgrp->{$grp} = [];

      foreach (@{$srsgrp{$srscat}}){       # save indiv statute data
        push @{$statgrp->{$grp}}, $_;      # & updt list of already
        $placedstats{$_->[0].$_->[1]} = 1; # classified statutes
      }
      next STATUTE;         # group found, go to next statute
    }
    else{                   # zerp bins are occupied -- error
      die "error!!";        # at least one bin should be occupied
    }
  }
}
print Dumper($statgrp);
return $rtncd;
} #end FindStatGrps()

__DATA__
0024.118.3A FT TFF
0024.118.3B FT TFF
0024.118.3C FT TFF
0024.118.3D FT TFF
0024.118.4  FF TFF
0039.04     NN OTH
0039.205.2  FT OTH
0039.205.6  FT TFF
409.176.12A FT TFF
409.176.12B FT TFF
409.176.12C FT TFF
409.176.12D FT OTH
409.176.12E FT OTH