#!/usr/bin/perl
use Device::USB ;

my $file = shift ( @ARGV ) ;
my $urb_start = shift ( @ARGV ) ;
my $urb_ende = shift ( @ARGV ) ;
my $timeout = 500 ;
my $buffer = "\0" x 512 ;
my $usb = Device::USB -> new() ;
my $dev = $usb -> find_device ( 0x04a9 , 0x2224 ) ;
$dev -> open() ;
print 'libusb:xxx:' , $dev -> filename() , "\n" ;

@data = control_msg ( $dev , '80 06 00 01 00 00 12 00' ) ;
printhex ( @data ) ;

open ( INDAT , '<' . $file ) ;

while ( !eof ( INDAT ) )
{
  ( $epD , $dataD , $infoD , $epB , $dataB , $infoB ) = get_urb_data() ;
  my @urb = split ( m![\(\)\s]+! , $infoD ) ;

  if ( $urb[3] eq 'URB' )
  {
    if ( $urb_start && ( $urb[4] < $urb_start ) )
    {
      next ( ) ;
    }

    if ( $urb_ende && ( $urb[4] > $urb_ende ) )
    {
      last ( ) ;
    }
  }

  print $infoD , "\n" ;
  my $cnt = $dev -> bulk_write ( hex($epD) , hex2bin($dataD) , $timeout ) ;

  if ( ( $cnt < 0 ) && ( $epD != '03' ) )
  {
#    error ( 'BULK > 0x' . $epD . ' returned error code ' . $cnt ) ;
print 'error: ' , $cnt , "\n" ;
  }

  if ( $epB )
  {
    print $infoB ;
    my $data = ' ' ;
    my $cnt = $dev -> bulk_read ( hex($epB) , $data , 1 , $timeout ) ;

    if ( $cnt < 0 )
    {
      print "\n" ;
      error ( 'BULK < 0x' . $epB . ' returned error code ' . $cnt ) ;
    }

    $data = bin2hex ( $data ) ;
    print ' ret=' , $data , "\n" ;
  }
}

close ( INDAT ) ;
1 ;

sub get_urb_data
{
  my $state = 'INFO_DOWN' ;
  my ( $typD , $dirD , $epD , $dataD , $infoD ) = ( ) ;
  my ( $typB , $dirB , $epB , $dataB , $infoB ) = ( ) ;

  while ( $zeile = <INDAT> )
  {
    chomp ( $zeile ) ;

    if ( substr ( $zeile , 0 , 1 ) eq '#' )
    {
      next ( ) ;
    }

    if ( $state eq 'INFO_DOWN' )
    {
      unless ( $zeile )
      {
        next ( ) ;
      }

      ( $typD , $dirD , $epD ) = split ( m! +! , $zeile ) ;
      $infoD = $zeile ;

      unless ( $typD eq 'BULK' )
      {
        error ( 'Type does not match BULK' , $zeile ) ;
      }

      $state = 'DATA_DOWN' ;
      $dataD = '' ;
    }
    elsif ( $state eq 'DATA_DOWN' )
    {
      if ( substr ( $zeile , 12 , 1 ) eq ':' )
      {
        $dataD .= $zeile ;
      }
      elsif ( $zeile )
      {
        ( $typB , $dirB , $epB ) = split ( m! +! , $zeile ) ;
        $infoB = $zeile ;

        unless ( $typB eq 'BULK' )
        {
          error ( 'Type does not match BULK' , $infoD , $zeile ) ;
        }

        $state = 'DATA_BACK' ;
        $dataB = '' ;
      }
      else
      {
        last ( ) ;
      }
    }
    elsif ( $state eq 'DATA_BACK' )
    {
      if ( substr ( $zeile , 12 , 1 ) eq ':' )
      {
        $dataB .= $zeile ;
      }
      elsif ( $zeile )
      {
        error ( 'Empty line expected' , $infoD , $infoB , $zeile ) ;
      }
      else
      {
        last ( ) ;
      }
    }
    else
    {
      error ( 'Illegal state' , $infoD , $zeile ) ;
    }
  }

  $dataD = dez2hex ( hex2dez ( $dataD ) ) ;
  $dataB = dez2hex ( hex2dez ( $dataB ) ) ;
  return ( $epD , $dataD , $infoD , $epB , $dataB , $infoB ) ;
}

sub bin2dez
{
  my ( $data ) = @_ ;
  my @data = unpack ( 'C*' , $data ) ;
  return ( @data )
}

sub dez2bin
{
  my ( @data ) = @_ ;
  my $data = pack ( 'C*' , @data ) ;
  return ( $data )
}

sub hex2dez
{
  my ( $txt ) = @_ ;
  $txt =~ s![\da-f]+:!!ig ;
  $txt =~ s!\A\s+!! ;
  $txt =~ s!\s+\Z!! ;
  my @data = split ( m!\s+! , $txt ) ;

  foreach ( @data )
  {
    $_ = hex ( $_ ) ;
  }

  return ( @data ) ;
}

sub dez2hex
{
  my ( @line ) = @_ ;
  my $anz = @line ;
  my $line = sprintf ( '%02x ' x $anz , @line ) ;
  return ( $line ) ;
}

sub bin2hex
{
  my ( $data ) = @_ ;
  my @data = bin2dez ( $data ) ;
  my $txt = dez2hex ( @data ) ;
  return ( $txt ) ;
}

sub hex2bin
{
  my ( $txt ) = @_ ;
  my @data = hex2dez ( $txt ) ;
  my $data = dez2bin ( @data ) ;
  return ( $data ) ;
}

sub control_msg
{
  my ( $dev , $txt ) = @_ ;
  my ( $typ , $req , $Lv , $Hv , $Li , $Hi , $Ls , $Hs ) = hex2dez ( $txt ) ;
  my $value = $Hv*256 + $Lv ;
  my $index = $Hi*256 + $Li ;
  my $size = $Hs*256 + $Ls ;
  my $buffer = "\0" x $size ;
  my $retval = $dev -> control_msg ( $typ , $req , $value , $index , $buffer , $size , $timeout ) ;
  my @buffer = bin2dez ( $buffer ) ;
  return ( @buffer ) ;
}

sub printhex
{
  my ( @data ) = @_ ;

  while ( @data )
  {
    my @line = splice ( @data , 0 , 16 ) ;
    my $line = dez2hex ( @line ) ;
    print $line , "\n" ;
  }
}

sub display
{
  my ( $dev , $key , $val , $txt ) = @_ ;
  my $pad = ' ' x 22 ;
  $key = substr ( $key . $pad , 0 , 22 ) ;

  if ( $txt == 1 )
  {
    $txt = $dev -> get_string_simple ( $val ) ;
  }

  if ( $txt )
  {
    $txt = ' (' . $txt . ')' ;
  }

  print ( $key , $val , $txt , "\n" ) ;
}

sub error
{
  my ( @msg ) = @_ ;
  $msg[0] .= ' !' ;
  print 'ERROR: ' , join ( "\n" , @msg ) , "\n" ;
  exit ;
}