#!/usr/bin/perl -w
package ParseStruct;

# this can handle several structs (parsed from the same .h file)
# should we make an internal package for one struct ? Currently $self->{structs}->{$struct_name}

# parsing of c-structures: google: pstruct
# there is also some modules on cpan that might be useful, Inline::Struct, Convert::Binary::C
# It's not clear if they worth the added problem (for newbies) of installing the modules.
# They are not exactly what we want. Could someone make them work?

use warnings;
use strict;
# use POSIX;

# PLEASE use this 'packaged' style of programming in the future
# it is much cleaner if variables are behind objects than
# using a huge gigantic namespace (especially if 'my' is never used)

sub new
{
	my ($this, $p) = @_;
	my $self={};
	my $class = ref($this) || $this;
	bless ($self, $class);
	$self->_init();
	return ($self);
}

sub _init
{
	my $self = shift;
	# $self->{debuglevel} = 4;
	$self->{wantedstructs} = {};
	# TODO: this is for all structs, should be per struct ?
	$self->{errors} = 0;
	# $self->{warnings} = 0;
}
# --------- SIMPLE accessors (getter-setter)
# give it a filename (could accept HANDLE ?)
sub datasource { $_[0]->{datasource} = $_[1] if defined $_[1]; $_[0]->{datasource} };
sub errors { $_[0]->{errors} = $_[1] if defined $_[1]; $_[0]->{errors} };
# -------------------------
# this accepts list of strings, and convert to hash
# should also accept listref or hashref 
sub wantedstructs {
	my $self = shift;
	# my $xref = shift; print "ref = " . ref $xref; ("ARRAY", or "HASH")
	my $wanted;	# struct_name
	for $wanted (@_){
		$self->{wantedstructs}->{$wanted} = 1;
		print STDERR "adding $wanted to hash \n"; 
	}
}
# -----
# 
sub getstructvars
{
	my $self = shift;
	my $struct_name = shift;
	$self->{structs}->{$struct_name}->{vars};
}
#-----------------
# reads all the structs (from the same datasource) determined by wantedstructs() 
sub readstructs
{
	my $self = shift;
	my $headerfilename = $self->{datasource};
open(GLOBAL, "<$headerfilename") or die "can't open $headerfilename";

my $l;
my $offset=0;
my $struct_name;
while($l = <GLOBAL>) {
	my $atom; my $atom_size;
    chomp $l;

    if ($l =~ /^\s*($|\/\/)/) {  # skip lines consisting of comments only
		# TODO: memorize comments ?
		next;
    }
    
	my ($st) = ($l =~ /^\s*struct\s+(\w[\w\d\_]*)\s*{/);
    if (defined $st ) { # eg. 'config_t'
    		$struct_name = $st;
#		print "found struct $struct_name\n";
    } elsif ($l =~ /\s*};/) { # the END
#		print "END of struct $struct_name\n";
		$struct_name = undef;
    } elsif ($struct_name) { # examine structure

	if( ! exists $self->{wantedstructs}->{$struct_name}){ # who cares ?
#		print "skipping struct $struct_name\n";
		next;
	} 
	# nice, a wanted structure
	
	# TODO: uint16_t
	if( $l =~ /^\s*(\#|\/\/)/ ){
		print "skipping line, offsets might be incorrect: $l\n";
		next;
	} elsif ($l =~ /^\s*uint(\d{1,2})_t\s+([\[\]\w\d]+)\s*;\s*(\/\/.*)?/) {
		my $atom = $1;
		if( $atom eq '8' ){
			$atom_size = 1;
		} elsif( $atom eq '16' ){
			$atom_size = 2;
                } elsif( $atom eq '32' ){
                	 $atom_size = 4;
                } else { 
                	print "You're OUT of LUCK, cannot figure out atom_size: $l\n";
                	next;
                }
	    my $name = $2;
	    if ($name =~ /(\w+)\[(\d+)\]/) {
			my $varname = $1;
			my $varsize = $2;
			my $i;
			for ($i=0; $i<$varsize; $i++) {
				my $full_varname = $varname . "[$i]";
				$self->{structs}->{$struct_name}->{vars}->{$full_varname} = $offset;
				$self->{structs}->{$struct_name}->{sizes}->{$full_varname} = $atom_size * $varsize;
				$self->{structs}->{$struct_name}->{offsets}->{$offset} = $full_varname;
		#	    print "$full_varname \@ " . $offset . "\n";
				$offset += $atom_size;
			}
	    } else {
			my $varname = $2;
			$self->{structs}->{$struct_name}->{vars}->{$varname} = $offset;
			$self->{structs}->{$struct_name}->{sizes}->{$varname} = $atom_size;
			$self->{structs}->{$struct_name}->{offsets}->{$offset} = $varname;
		#	print "$varname \@ " . $offset . "\n";
			$offset += $atom_size;
	    }
	} else {
	    print STDERR "ERROR: can't understand \"$l\" in file $headerfilename\n";
	    print STDERR "***** The above error is FATAL! ***** \n";
	    $self->{errors}++;
	}
    }
}
close GLOBAL;

} # sub readstructs

1;
