#!/usr/bin/env perl
# brcm-firmware-map -- map hex firmware files to linux hcd file names
# Author: Noah Friedman <friedman@splode.com>
# Created: 2016-05-21
# Public domain

# $Id: brcm-firmware-map,v 1.3 2017/08/08 23:19:25 friedman Exp $

# Commentary:

# Usage: brcm-firmware-map /path/to/bcbtums.inf another.inf ...

# Debugging output can be enabled/dissabled per function and/or line number, e.g.
# 	DEBUG=all,!parse:108 brcm-firmware-map ...
#	DEBUG=bcm_devmap brcm-firmware-map ...
#
# Suggested conversion script:
#
#       #!/bin/sh
# 	mkdir -p hcd;
#
# 	brcm-firmware-map "$@" |
# 	    while read hex hcd; do
# 	        hex2hcd -o hcd/$hcd hex/$hex &&
# 	            touch -r hex/$hex hcd/$hcd
# 	    done

# Most recent firmware files can be found via
# 	http://www.catalog.update.microsoft.com/Search.aspx?q=Broadcom+bluetooth

# Code:

use strict;
use warnings qw(all);

use Regexp::Grammars;

use FindBin;
use lib "$FindBin::Bin/../../lib/perl";
use lib "$ENV{HOME}/lib/perl";

use NF::PrintObject qw(debug_pp :vars);
$object_pp_verbose  =  3;
$object_pp_maxwidth = 80;

# Assumes comments have been completely stripped
my $ini_grammar
  = qr{ <nocontext:> <ini>

        <rule:  ini>        <[section]>+
        <rule:  section>    \[ <name> \] <[data]>*

        <token: name>        .+
        <rule:  data>       <key> \= <val> | <val>
        <rule:  key>        [^][\s]+
        <rule:  val>        [^][\r\n]+
      }mx;

sub file_contents
{
  open (my $fh, $_[0]) || die "$_[0]: $!\n";
  local $/ = undef;
  scalar <$fh>;
}

sub parse
{
  my $text = file_contents (shift);
  $text =~ s/\s*\r//g;
  $text =~ s/\s*;.*//g;

  debug_pp (\%/);
  return unless $text =~ $ini_grammar;

  my %inf;
  for my $section (@{$/{ini}->{section}})
    {
      my ($name, $data) = ($section->{name}, $section->{data});
      if (exists $data->[0]->{key})
        {
          for my $elt (@$data)
            {
              my $key = $elt->{key};
              my $val = $inf{$name}->{$key} ||= [];

              my @new = split (/\s*,\s*/, $elt->{val}, -1);
              debug_pp (@new);
              if (@new > 1) { push @$val, \@new; }
              else { push @$val, @new; }
              debug_pp ($val);
            }
        }
      else
        {
          $inf{$name} = [ map { my @l = split (/\s*,\s*/, $_->{val}, -1);
                                @l > 1 ? \@l : @l;
                              } @$data ];
        }
    }
  debug_pp (\%inf);

  return \%inf;
}

sub get
{
  my ($obj, $section) = (shift, shift);

  my $data = $obj->{$section};
  return unless $data;
  debug_pp ($data, @_);
  unless (@_)
    {
      if (ref $data eq 'HASH')
           { return wantarray ? %$data : $data; }
      else { return wantarray ? @$data : $data; }
    }

  my @result = (ref $data eq 'HASH'
                ? map { @{$data->{$_}} } @_
                : map { @{$data->[$_]} } @_);
  debug_pp (@result);
  return unless @result;
  return wantarray ? @result : \@result;
}

sub bcm_devmap
{
  my $obj = shift;

  my @sections = map { my $prefix = shift @$_;
                       map { $prefix.'.'.$_ } @$_;
                     } get ($obj, 'Manufacturer', '%MfgName%', '%MfgName64%');
  debug_pp (\@sections);

  my %devmap;
  map { my $section = get ($obj, $_);
        debug_pp ($_, $section);
        for my $elt (values %$section)
          {
            debug_pp ($elt);
            for my $row (@$elt)
              {
                debug_pp ($row);
                my ($key, $val) = @$row;
                $devmap{$key} = sprintf ("%s-%s.hcd", lc $1, lc $2)
                  if $val && $val =~ /USB.VID_([\da-f]+).PID_([\da-f]+)/i;
              }
          }
      } @sections;
  debug_pp (\%devmap);
  return \%devmap;
}

sub bcm_hexfile
{
  my ($obj, $dev) = @_;
  grep { /\.hex$/
       } map { get ($obj, $_)
             } get ($obj, "$dev.NT", "CopyFiles");
}

sub main
{
  my @list;
  for my $file (@_)
    {
      my $obj = parse ($file);
      next unless $obj;

      my $devmap = bcm_devmap ($obj);
      push @list, map
        { my ($hf) = bcm_hexfile ($obj, $_);
          if (defined $hf)
            {
              my $prefix = $1 if $hf =~ /^(.*?)_/;
              sprintf "%s\t%s-%s\n", $hf, $prefix, $devmap->{$_};
            }
        } keys %$devmap;
    }
  print sort @list;
}

main (@ARGV);

# eof