# Copyright (c) 2024 Yuki Kimoto
# MIT License

class Packer {
  version_from SPVM;

  
  use Packer::Specifier;
  use StringBuffer;
  use Fn;
  
  # Class Methods
  static method new : Packer () {
    
    my $self = new Packer;
    
    return $self;
  }
  
  precompile method pack : string ($template : string, $objects : object[]) {
    
    unless ($template) {
      die "The template \$template must be defined.";
    }
    
    unless ($objects) {
      die "The objects \$objects must be defined.";
    }
    
    my $specifiers = $self->_parse_template($template);
    
    my $specifiers_length = @$specifiers;
    
    my $objects_length = @$objects;
    
    unless ($specifiers_length <= $objects_length) {
      die "The length of the specifiers in the template '$template' must be less than or equal to the lenght of the objects \$objects.";
    }
    
    my $binary_buffer = StringBuffer->new;
    for (my $i = 0; $i < $specifiers_length; $i++) {
      
      my $specifier = $specifiers->[$i];
      
      my $specifier_type = $specifier->{type};
      
      my $is_numeric_object = $specifier->{is_numeric_object};
      
      my $endian = $specifier->{endian};
      
      my $length = $specifier->{length};
      
      my $has_wildcard_length = $specifier->{has_wildcard_length};
      
      my $object = $objects->[$i];
      
      my $size = 0;
      
      my $values = (object)undef;
      
      switch ($specifier_type) {
        
        case Packer::Specifier->TYPE_STRING : {
          $size = 1;
          
          $values = (string)$object;
        }
        case Packer::Specifier->TYPE_HEX_STRING_LOW :
        case Packer::Specifier->TYPE_HEX_STRING_HIGH :
        {
          $size = 1;
          
          my $hex_string = (string)$object;
          
          my $hex_string_length = length $hex_string;
          
          my $values_buffer = StringBuffer->new;
          for (my $i = 0; $i < $hex_string_length; $i += 2) {
            
            my $hex_char_high = $hex_string->[$i];
            
            unless (Fn->is_hex_digit($hex_char_high)) {
              die "Input contains non hex character.";
            }
            
            my $hex_char_low = '\x30'; # 0
            if ($i + 1 < $hex_string_length) {
              $hex_char_low = $hex_string->[$i + 1];
              unless (Fn->is_hex_digit($hex_char_high)) {
                die "Input contains non hex character.";
              }
            }
            
            my $hex_char = (string)undef;
            if ($specifier_type == Packer::Specifier->TYPE_HEX_STRING_HIGH) {
              $hex_char = Fn->chr($hex_char_high) . Fn->chr($hex_char_low);
            }
            elsif ($specifier_type == Packer::Specifier->TYPE_HEX_STRING_LOW) {
              $hex_char = Fn->chr($hex_char_low) . Fn->chr($hex_char_high);
            }
            else {
              die "[Unexpected Error]Invalid specifier type";
            }
            
            my $byte_number = Fn->hex($hex_char);
            
            $values_buffer->push_char($byte_number);
          }
          
          $values = $values_buffer->to_string;
        }
        case Packer::Specifier->TYPE_BYTE : {
          
          if ($is_numeric_object) {
            unless ($object is_type Byte) {
              die "The type of the element in the objects \$objects at index $i must be Byte type.";
            }
            
            $values = [(byte)$object];
          }
          else {
            unless ($object is_type byte[]) {
              die "The type of the element in the objects \$objects at index $i must be byte[] type.";
            }
            
            $values = (byte[])$object;
          }
          
          $size = 1;
        }
        case Packer::Specifier->TYPE_SHORT : {
          
          if ($is_numeric_object) {
            unless ($object is_type Short) {
              die "The type of the element in the objects \$objects at index $i must be Short type.";
            }
            
            $values = [(short)$object];
          }
          else {
            unless ($object is_type short[]) {
              die "The type of the element in the objects \$objects at index $i must be short[] type.";
            }
            
            $values = (short[])$object;
          }
          
          $size = 2;
        }
        case Packer::Specifier->TYPE_INT : {
          
          if ($is_numeric_object) {
            unless ($object is_type Int) {
              die "The type of the element in the objects \$objects at index $i must be Int type.";
            }
            
            $values = [(int)$object];
          }
          else {
            unless ($object is_type int[]) {
              die "The type of the element in the objects \$objects at index $i must be int[] type.";
            }
            
            $values = (int[])$object;
          }
          
          $size = 4;
        }
        case Packer::Specifier->TYPE_LONG : {
          
          if ($is_numeric_object) {
            unless ($object is_type Long) {
              die "The type of the element in the objects \$objects at index $i must be Long type.";
            }
            
            $values = [(long)$object];
          }
          else {
            unless ($object is_type long[]) {
              die "The type of the element in the objects \$objects at index $i must be long[] type.";
            }
            
            $values = (long[])$object;
          }
          
          $size = 8;
        }
        case Packer::Specifier->TYPE_FLOAT : {
          
          if ($is_numeric_object) {
            unless ($object is_type Float) {
              die "The type of the element in the objects \$objects at index $i must be Float type.";
            }
            
            $values = [(float)$object];
          }
          else {
            unless ($object is_type float[]) {
              die "The type of the element in the objects \$objects at index $i must be float[] type.";
            }
            
            $values = (float[])$object;
          }
          
          $size = 4;
        }
        case Packer::Specifier->TYPE_DOUBLE : {
          
          if ($is_numeric_object) {
            unless ($object is_type Double) {
              die "The type of the element in the objects \$objects at index $i must be Double type.";
            }
            
            $values = [(double)$object];
          }
          else {
            unless ($object is_type double[]) {
              die "The type of the element in the objects \$objects at index $i must be double[] type.";
            }
            
            $values = (double[])$object;
          }
          
          $size = 8;
        }
        default : {
          die "[Unexpected Error]Invalid specifier type.";
        }
      }
      
      my $process_length = 0;
      if ($has_wildcard_length) {
        $process_length = Fn->length($values);
      }
      else {
        $process_length = $length;
      }
      
      if ($specifier_type == Packer::Specifier->TYPE_HEX_STRING_LOW || $specifier_type == Packer::Specifier->TYPE_HEX_STRING_HIGH) {
        $process_length = ($process_length + 1) / 2;
      }
      
      my $binary_part_size = $size * $process_length;
      
      my $copy_size = 0;
      if (Fn->length($values) < $process_length) {
        $copy_size = $size * Fn->length($values);
      }
      else {
        $copy_size = $size * $process_length;
      }
      
      my $binary_part = (mutable string)new_string_len $binary_part_size;
      
      Fn->memcpy($binary_part, 0, $values, 0, $copy_size);
      
      if ($endian == Packer::Specifier->ENDIAN_BIG_ENDIAN || $endian == Packer::Specifier->ENDIAN_LITTLE_ENDIAN) {
        for (my $i = 0; $i < $process_length; $i++) {
          my $binary_part_offset = $size * $i;
          if ($endian == Packer::Specifier->ENDIAN_BIG_ENDIAN) {
            Fn->system_endian_to_big_endian($binary_part, $size);
          }
          elsif ($endian == Packer::Specifier->ENDIAN_LITTLE_ENDIAN) {
            Fn->system_endian_to_little_endian($binary_part, $size);
          }
        }
      }
      
      $binary_buffer->push($binary_part);
    }
    
    my $binary = $binary_buffer->to_string;
    
    return $binary;
  }
  
  precompile method unpack : object[] ($template : string, $binary : string) {
    
    unless ($template) {
      die "The template \$template must be defined.";
    }
    
    unless ($binary) {
      die "The binary data \$binary must be defined.";
    }
    
    my $binary_length = length $binary;
    
    my $specifiers = $self->_parse_template($template);
    
    my $specifiers_length = @$specifiers;
    
    my $binary_offset = 0;
    
    my $objects_list = List->new(new object[0]);
    
    for (my $i = 0; $i < $specifiers_length; $i++) {
      
      my $specifier = $specifiers->[$i];
      
      my $specifier_type = $specifier->{type};
      
      my $endian = $specifier->{endian};
      
      my $length = $specifier->{length};
      
      my $has_wildcard_length = $specifier->{has_wildcard_length};
      
      my $is_numeric_object = $specifier->{is_numeric_object};
      
      my $size = 0;
      
      switch ($specifier_type) {
        case Packer::Specifier->TYPE_STRING : {
          $size = 1;
        }
        case Packer::Specifier->TYPE_HEX_STRING_LOW :
        case Packer::Specifier->TYPE_HEX_STRING_HIGH :
        {
          $size = 1;
        }
        case Packer::Specifier->TYPE_BYTE : {
          $size = 1;
        }
        case Packer::Specifier->TYPE_SHORT : {
          $size = 2;
        }
        case Packer::Specifier->TYPE_INT : {
          $size = 4;
        }
        case Packer::Specifier->TYPE_LONG : {
          $size = 8;
        }
        case Packer::Specifier->TYPE_FLOAT : {
          $size = 4;
        }
        case Packer::Specifier->TYPE_DOUBLE : {
          $size = 8;
        }
        default : {
          die "[Unexpected Error]Invalid specifier type.";
        }
      }
      
      my $process_length = $length;
      
      if ($has_wildcard_length) {
        $process_length = ($binary_length - $binary_offset) / $size;
      }
      
      if ($specifier_type == Packer::Specifier->TYPE_HEX_STRING_LOW || $specifier_type == Packer::Specifier->TYPE_HEX_STRING_HIGH) {
        $process_length = ($process_length + 1) / 2;
      }
      
      unless ($binary_offset + $size * $process_length <= $binary_length) {
        die "The current offset $binary_offset plus (the size $size * the process length culcuralted by $length of the specifier) must be less than the length($binary_length) of the binary data \$binary.";
      }
      
      my $binary_part_size = $size * $process_length;
      
      my $binary_part = (mutable string)new_string_len $binary_part_size;
      
      Fn->memcpy($binary_part, 0, $binary, $binary_offset, $binary_part_size);
      
      if ($endian == Packer::Specifier->ENDIAN_BIG_ENDIAN || $endian == Packer::Specifier->ENDIAN_LITTLE_ENDIAN) {
        for (my $i = 0; $i < $process_length; $i++) {
          my $binary_part_offset = $size * $i;
          if ($endian == Packer::Specifier->ENDIAN_BIG_ENDIAN) {
            Fn->big_endian_to_system_endian($binary_part, $size);
          }
          elsif ($endian == Packer::Specifier->ENDIAN_LITTLE_ENDIAN) {
            Fn->little_endian_to_system_endian($binary_part, $size);
          }
        }
      }
      
      my $object = (object)undef;
      switch ($specifier_type) {
        
        case Packer::Specifier->TYPE_STRING : {
          $object = $binary_part;
        }
        case Packer::Specifier->TYPE_HEX_STRING_LOW :
        case Packer::Specifier->TYPE_HEX_STRING_HIGH :
        {
          my $byte_numbers = (byte[])$binary_part;
          
          my $int_object_array = new Int[$process_length];
          
          for (my $i = 0; $i < length $binary_part; $i++) {
            my $number = $binary_part->[$i];
            
            $int_object_array->[$i] = Int->new($number & 0xFF);
          }
          
          my $format = Fn->repeat("%x", $process_length);
          
          my $hex_string_part = (mutable string)Fn->sprintf($format, (object...)$int_object_array);
          
          if ($specifier_type == Packer::Specifier->TYPE_HEX_STRING_LOW) {
            for (my $i = 0; $i < $process_length; $i++) {
              my $tmp = $hex_string_part->[$i * 2];
              $hex_string_part->[$i * 2] = $hex_string_part->[$i * 2 + 1];
              $hex_string_part->[$i * 2 + 1] = $tmp;
            }
          }
          
          unless ($has_wildcard_length) {
            Fn->shorten($hex_string_part, $length);
          }
          
          $object = $hex_string_part;
        }
        case Packer::Specifier->TYPE_BYTE : {
          $object = new byte[$process_length];
          
          Fn->memcpy($object, 0, $binary_part, 0, $binary_part_size);
          
          if ($is_numeric_object) {
            $object = Byte->new($object->(byte[])->[0]);
          }
        }
        case Packer::Specifier->TYPE_SHORT : {
          $object = new short[$process_length];
          
          Fn->memcpy($object, 0, $binary_part, 0, $binary_part_size);
          
          if ($is_numeric_object) {
            $object = Short->new($object->(short[])->[0]);
          }
        }
        case Packer::Specifier->TYPE_INT : {
          $object = new int[$process_length];
          
          Fn->memcpy($object, 0, $binary_part, 0, $binary_part_size);
          
          if ($is_numeric_object) {
            $object = Int->new($object->(int[])->[0]);
          }
        }
        case Packer::Specifier->TYPE_LONG : {
          $object = new long[$process_length];
          
          Fn->memcpy($object, 0, $binary_part, 0, $binary_part_size);
          
          if ($is_numeric_object) {
            $object = Long->new($object->(long[])->[0]);
          }
        }
        case Packer::Specifier->TYPE_FLOAT : {
          $object = new float[$process_length];
          
          Fn->memcpy($object, 0, $binary_part, 0, $binary_part_size);
          
          if ($is_numeric_object) {
            $object = Float->new($object->(float[])->[0]);
          }
        }
        case Packer::Specifier->TYPE_DOUBLE : {
          $object = new double[$process_length];
          
          Fn->memcpy($object, 0, $binary_part, 0, $binary_part_size);
          
          if ($is_numeric_object) {
            $object = Double->new($object->(double[])->[0]);
          }
        }
        default : {
          die "[Unexpected Error]Invalid specifier type.";
        }
      }
      
      $objects_list->push($object);
      
      $binary_offset += $binary_part_size;
    }
    
    my $objects = $objects_list->to_array;
    
    return $objects;
  }
  
  private precompile method _parse_template : Packer::Specifier[] ($template : string) {
    
    my $template_length = length $template;
    
    my $template_index = 0;
    
    my $specifiers_list = List->new(new Packer::Specifier[0]);
    
    while (1) {
      
      unless ($template_index < $template_length) {
        last;
      }
      
      my $ch = $template->[$template_index];
      
      # Parse a specifier
      my $specifier_type = Packer::Specifier->TYPE_NONE;
      switch ($ch) {
        
        # String
        case 'a' : {
          $specifier_type = Packer::Specifier->TYPE_STRING;
        }
        # A hex string (low nybble first)
        case 'h' : {
          $specifier_type = Packer::Specifier->TYPE_HEX_STRING_LOW;
        }
        # A hex string (high nybble first)
        case 'H' : {
          $specifier_type = Packer::Specifier->TYPE_HEX_STRING_HIGH;
        }
        # Signed 8-bit integers
        case 'c' : {
          $specifier_type = Packer::Specifier->TYPE_BYTE;
        }
        # Unsigned 8-bit integers
        case 'C' : {
          $specifier_type = Packer::Specifier->TYPE_BYTE;
        }
        # Signed 16-bit integers
        case 's' : {
          $specifier_type = Packer::Specifier->TYPE_SHORT;
        }
        # Unsigned 16-bit integers
        case 'S' : {
          $specifier_type = Packer::Specifier->TYPE_SHORT;
        }
        # Signed 32-bit integers
        case 'l' : {
          $specifier_type = Packer::Specifier->TYPE_INT;
        }
        # Unsigned 32-bit integers
        case 'L' : {
          $specifier_type = Packer::Specifier->TYPE_INT;
        }
        # Signed 32-bit integers
        case 'q' : {
          $specifier_type = Packer::Specifier->TYPE_LONG;
        }
        # Unigned 32-bit integers
        case 'Q' : {
          $specifier_type = Packer::Specifier->TYPE_LONG;
        }
        # 16-bit floating point numbers
        case 'f' : {
          $specifier_type = Packer::Specifier->TYPE_FLOAT;
        }
        # 32-bit floating point numbers
        case 'd' : {
          $specifier_type = Packer::Specifier->TYPE_DOUBLE;
        }
        default : {
          die "Invalid specifier " . Fn->chr($ch) . " in the template '$template'.";
        }
      }
      
      $template_index++;
      
      # Prase endian
      my $endian = Packer::Specifier->ENDIAN_NONE;
      if ($template_index < $template_length) {
        $ch = $template->[$template_index];
        
        if ($ch == '>') {
          $endian = Packer::Specifier->ENDIAN_BIG_ENDIAN;
          $template_index++;
        }
        elsif ($ch == '<') {
          $endian = Packer::Specifier->ENDIAN_LITTLE_ENDIAN;
          $template_index++;
        }
      }
      
      # Parse length
      my $is_numeric_object = 0;
      my $has_wildcard_length = 0;
      my $length = 0;
      if ($template_index < $template_length && $template->[$template_index] == '*') {
        $has_wildcard_length = 1;
        $template_index++;
      }
      else {
        my $length_string = "";
        while (1) {
          unless ($template_index < $template_length) {
            last;
          }
          $ch = $template->[$template_index];
          
          if (Fn->is_digit($ch)) {
            $length_string .= Fn->chr($ch);
            $template_index++;
          }
          else {
            last;
          }
        }
        
        if (length $length_string) {
          $length = Fn->to_int($length_string);
          
          unless ($length > 0) {
            die "The data length $length in the template in the template '$template' must be a positive value.";
          }
        }
        else {
          $length = 1;
          $is_numeric_object = 1;
        }
      }
      
        
      if ($specifier_type == Packer::Specifier->TYPE_STRING) {
        if ($is_numeric_object) {
          die "The data length $length for 'a' in the template in the template '$template' must be specified.";
        }
      }
      
      my $specifier = new Packer::Specifier;
      $specifier->{type} = $specifier_type;
      $specifier->{is_numeric_object} = $is_numeric_object;
      $specifier->{endian} = $endian;
      $specifier->{length} = $length;
      $specifier->{has_wildcard_length} = (byte)$has_wildcard_length;
      
      $specifiers_list->push($specifier);
    }
    
    my $specifiers = (Packer::Specifier[])$specifiers_list->to_array;
    
    return $specifiers;
  }
  
}
