view release on metacpan or  search on metacpan

memory_map_2300.PL  view on Meta::CPAN

#!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;