#!perl
#
# memory_map_2300.PL - creates a MemoryMap.pm
#
use strict;
use warnings;

# ExtUtils::MakeMaker invokes us, via make, with the first arg
# pointing to the name of our destination file.
my $mmap = shift || die "Usage: $0 PATH-TO-MEMORY-MAP-PM-FILE\n";
my $tmpfile = "$mmap.tmp.$$";
unlink $tmpfile;
open my $mmap_fh, '>', $tmpfile
    or die "Cannot create $tmpfile: $!\n";

# The _canonical_name() function is defined in the DATA section below.
# We want to eval it, and also need to include it in the .pm source.
my $canonical_name_func = do { local $/; <DATA>; }; close DATA;
eval $canonical_name_func;
die "$0: $@" if $@;

# Read in the memory map...
(my $mapfile = $0) =~ s!^(.*/)?(.*)\.PL$!$2.txt!;
open IN, "<$mapfile"
  or die "Cannot read $mapfile: $!";

my @map;
my %macro;
my $previous_address;
while (my $line = <IN>) {
    chomp $line;
    $line =~ s/\s+$//;			# Remove trailing whitespace

    # E.g. 0019 0   alarm set flags
    if ($line =~ s!^([0-9a-f]{4})\s+[0-9a-f]\s*!!i) {
	my $address = hex($1);

	# This is not expected to trigger: check the sequence
	if (defined $previous_address) {
	    $address == $previous_address+1
	      or die sprintf("$mapfile:$.: Error between %04X and %04X",
			     $previous_address, $address);
	}
	$previous_address = $address;

	# Anything in plain parentheses, at the end, is a comment:
	#    0266 4    | LCD contrast: $BCD+1 (Read Only: ....)
	# strip it off.
	$line =~ s/\s*\([^\(]+\)$//;

	# Is it a definition line?
	if ($line =~ m!^\|\s+([^ 0-9].*?)\s*:\s*(.*)!) {
	    my ($desc, $formula) = ($1, $2);
	    push @map, {
			desc => $desc,
			name => _canonical_name($desc),
			address => $address,
			length => 1,
			   };

	    # FIXME: formula
	    $formula =~ s{<(\S+)>}{
		my $key = $1;
		defined $macro{$key}
		  or die "$mapfile:$.: Undefined macro <$key>";
		$macro{$key};
	    }ge;

	    if ($formula =~ s/\s*\[(.*)\]\s*//) {
		$map[-1]->{units} = $1;
	    }

	    $map[-1]->{formula} = $formula;
	}
	elsif ($line =~ m!^_/!) {
	    my $l = $address - $map[-1]->{address} + 1;
	    if ($l > 10) {
		die "$mapfile:$.: preposterous length";
	    }
	    $map[-1]->{length} = $l;
	}
    }
    elsif ($line =~ /^\s*macro \s+ (\S+) \s+ = \s+ (\S.*\S)/x) {
	$macro{$1} = $2;
    }
    else {
	# FIXME: check for macro definition lines
    }
}
close IN;

#
# ...write out the map file...
#
print { $mmap_fh } <<'END_MMAP_HEADER';
# -*- perl -*-
#
###############################################################################
# This file is autogenerated by $0.  DO NOT EDIT!
###############################################################################
#
package Device::LaCrosse::WS23xx::MemoryMap;

use strict;
use warnings;
use Carp;

my $_memory_map = <<'END_MEMORY_MAP';
END_MMAP_HEADER

for my $entry (@map) {
    my $name = $entry->{name};
    if (my $units = $entry->{units}) {
	$name .= " [$units]";
    }

    printf { $mmap_fh } "%04X:%-2d %-40s %s\n", @{$entry}{"address","length"},
      $name, $entry->{formula};
}

print { $mmap_fh } <<'END_MMAP_REST';
END_MEMORY_MAP

my $Canonical = <<'END_CANONICAL';
Max		Maximum | Maximal
Min		Minimum | Minimal

Indoor		Indoors  | Inside  | In
Outdoor		Outdoors | Outside | Out

Pressure	Press | Air Pressure
Temperature	Temp
Humidity	Hum   | Relative Humidity | Rel Humidity
Windchill	Wind Chill
Wind_Speed	Wind Speed | Windspeed
Dewpoint	Dew Point
Rain		Rainfall  | Rain
END_CANONICAL




sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;

    my $self = {
	fields => {},
    };

    # Read and parse the memory map at top.
    for my $line (split "\n", $_memory_map) {
	next if $line =~ m!^\s*$!;		# Skip blank lines
	next if $line =~ m!^\s*#!;		# Skip comments

	$line =~ /^(\S+):(\S+)\s+(\S+)(\s+\[(.*?)\])?\s+(\S.*\S)/
	  or die "Internal error: Cannot grok '$line'";
	$self->{fields}{lc $3} = {
	    address => hex($1),
	    count   => $2,
	    name  => $3,
	    units => $5 || '?',
	    expr  => $6,
	};
    }

    return bless $self, $class;
}

sub find_field {
    my $self = shift;
    my $field = shift;

    # Canonicalize the requested field name, e.g.
    # 'Indoor Temp Max' => Max_Indoor_Temperature
    my $canonical_field = _canonical_name($field);
    if (! exists $self->{fields}->{lc $canonical_field}) {
	(my $re = lc $field) =~ s/[ _]+/.*/g;
	my @match = grep { /$re/i } keys %{$self->{fields}};
	if (@match == 1) {
	    $canonical_field = $match[0];
	}
    }

    # Get the field info.
    # FIXME: If there's no such field, return undef instead of croaking?
    return $self->{fields}->{lc $canonical_field}
      or croak "No such value, '$field'";
}

END_MMAP_REST

print { $mmap_fh } $canonical_name_func;

print { $mmap_fh } <<'END_MMAP_REST';

=head1 NAME

Device::LaCrosse::WS23xx::MemoryMap - Weather station address meanings

=head1 SYNOPSIS

    use Device::LaCrosse::WS23xx::MemoryMap;

    my $map = Device::LaCrosse::WS23xx::MemoryMap->new();

This is NOT intended as a user-visible module.  It is
used internally by Device::LaCrosse::WS23xx.  This interface
is subject to change without notice.

=head1  DESCRIPTION

=head1  CONSTRUCTOR

=over 4

=item B<new>()

Parses the data table contained in the module itself.

=back

=head1  METHODS

=over 4

=item   B<find_field>( FIELD )

Canonicalizes B<FIELD> and looks it up.  If found, returns a
hashref with the following elements:

=over 8

=item	name

Canonical field name.

=item	units

Units of the measurement.  See Units below.

=item	address

Starting address of this field in the WS-23xx memory map

=item	count

Length, in nybbles, of the field.

=item	expr

Perl expression used to convert data nybbles to a useful form.

=back

If FIELD is not found, returns undef.

=back

=head2	Known Fields

The known data fields -- i.e., what you can use as an
argument to Device::LaCrosse::WS23xx->get() -- are:

END_MMAP_REST

for my $entry (@map) {
    my $name = sprintf("%-40s", $entry->{name});

    if (my $units = $entry->{units}) {
	$name .= $units;
    }
    $name =~ s/\s+$//;

    print  { $mmap_fh } "   ", $name, "\n";
}


print { $mmap_fh } <<'END_MMAP_FINAL';

Where applicable, units are displayed to the right of each field.

=head2	Units

The WS-23xx devices return data in the following units:

=over 8

=item	B<C>

Degrees Centigrade (temperature)

=item	B<%>

Percent (humidity)

=item	B<hPa>

hectoPascals (pressure)

=item	B<m/s>

Meters per Second (wind speed)

=item	B<mm>

Millimeters (rainfall)

=item	B<degrees>

Compass degrees, 0-359, (wind direction)

=item	B<minutes>

Minutes.

=item	B<seconds>

Seconds.

=item	B<time_t>

Seconds since the Epoch; you probably want to use it as
an argument to B<localtime>().

=back


=head1  AUTHOR

Ed Santiago <esm@cpan.org>

=head1	SEE ALSO

L<Device::LaCrosse::WS23xx>

=cut


1;
END_MMAP_FINAL

close $mmap_fh
    or die "$0: Error writing $mmap: $!\n";
chmod 0444 => $mmap;
rename $tmpfile => $mmap
    or die "$0: could not rename $tmpfile: $!\n";

exit 0;


__DATA__

################
#
# canonical_name
#
sub _canonical_name {
    my $desc = shift;
    my $canonical_name = '';

    $desc =~ s/_/ /g;

    # Min or Max?
    if ($desc =~ s/\bmin(imum)?\b/ /i) {
	$canonical_name .= 'Min_';
    }
    elsif ($desc =~ s/\bmax(imum)?\b/ /i) {
	$canonical_name .= 'Max_';
    }
    elsif ($desc =~ s/\b(High|Low)\s*Alarm\b/ /i) {
	$canonical_name .= ucfirst(lc($1)) . '_Alarm_';
    }
    elsif ($desc =~ s/\bCurrent\b/ /i) {
	# do nothing
    }

    # Where?
    if ($desc =~ s/\b(in|out)(doors?)?(\b|$)/ /i) {
	$canonical_name .= ucfirst(lc($1) . 'door') . '_';
    }

    # What: Temperature, Windchill, Pressure, ...
    if ($desc =~ s/\btemp(erature)?\b/ /i) {
	$canonical_name .= 'Temperature';
    }
    elsif ($desc =~ s/\bPress(ure)?\b/ /i) {
	$desc =~ s/\bair\b/ /i;

	if ($desc =~ s/\bAbs(olute)?\b/ /i) {
	    $canonical_name .= 'Absolute_';
	}
	elsif ($desc =~ s/\bRel(ative)?\b/ /i) {
	    $canonical_name .= 'Relative_';
	}
	$canonical_name .= 'Pressure';
	if ($desc =~ s/\bCorrection\b/ /i) {
	    $canonical_name .= '_Correction';
	}
    }
    elsif ($desc =~ s/\b(Humidity|Windchill|Dewpoint)\b/ /i) {
	$canonical_name .= ucfirst(lc($1));
	$desc =~ s/\bRel(ative)?\b/ /i;
    }
    elsif ($desc =~ s/\b(Rain)\b//i) {
	$canonical_name .= "Rain";
	if ($desc =~ s/\b(1|24)(\s*h(ou)?r?)?\b//i) {
	    $canonical_name .= "_$1hour";
	}
	elsif ($desc =~ s/\btotal\b//i) {
	    $canonical_name .= "_Total";
	}
    }
    else {
	(my $tmp = $desc) =~ s/\s+/_/g;
	$canonical_name .= $tmp;
	# FIXME: warn?
    }

    # Is this a date/time field?
    if ($desc =~ s!\bDate/Time\b! !i) {
	$canonical_name .= '_datetime';
    }

    if ($desc =~ /\S/) {
#	warn "leftover: $desc\n";
    }

    $canonical_name =~ s/_$//;

    return $canonical_name;
}

# END   canonical_name