# Convenience, actually out of WSP
OCTET:          /[\x00-\xFF]/
CHAR:           /[\x00-\x7F]/
UPALPHA:        /[A-Z]/
LOALPHA:        /[a-z]/
ALPHA:          /[a-zA-Z]/
DIGIT:          /\d/
CTL:            /[\x00-\x1F\x7F]/
CR:             "\x0D"
LF:             "\x0A"
SP:             "\x20"
HT:             "\x09"
RFC2616_QUOTE:  "\x22"
#
CRLF: CR LF { $return = "\r\n"; 1; }
LWS:  CRLF(?) ( SP | HT )(1..) {
   $return = join '', @{$item[1]}, @{$item[2]};
   1;
}
#
_non_CTL:  /[^\x00-\x1F\x7F]/
TEXT: ( _non_CTL | LWS )(s) {
   $return = join '', @{$item[1]};
   1;
}
#
HEX:  /[a-fA-F0-9]/
separator:  "(" | ")" | "<" | ">" | "@"
          | "," | ";" | ":" | "\\" | RFC2616_QUOTE
          | "/" | "[" | "]" | "?" | "="
          | "{" | "}" | SP | HT
token: (...!CTL ...!separator CHAR)(s) {
   $return = join '', @{$item[1]};
   1;
}
# Convenience
HIGHOCTET:    /[\x80-\xFF]/
#
# bit: undefined
octet:   OCTET
uint8:   OCTET     { $return = unpack 'C', $item[1]; 1; }
uint16:  OCTET(2)  { $return = unpack 'n', join '', @{$item[1]}; 1; }
uint32:  OCTET(4)  { $return = unpack 'N', join '', @{$item[1]}; 1; }
uintvar:  HIGHOCTET(0..4) CHAR  {
   $return = 0;
   foreach my $high ( @{$item[1]} ) {
      $return |= ord($high) & 0x7F;
      $return <<= 7;
   }
   $return |= ord($item{CHAR});
   1;
}
TID: uint8
PDU_type: Reserved | Connect | ConnectReply | Redirect | Reply
        | Disconnect | Push | ConfirmedPush | Suspend | Resume
        | Unassigned
        | Get | Options_GetPDU | Head_GetPDU | Delete_GetPDU | Trace_GetPDU 
              | Unassigned_GetPDU | ExtendedMethod_GetPDU
        | Post | Put_PostPDU 
              | Unassigned_PostPDU | ExtendedMethod_PostPDU
        | DataFragmentPDU
Reserved: /[\x00\x81-\xff]/ { $return = $item[0]; 1; }
Connect: "\x01" { $return = $item[0]; 1; }
ConnectReply: "\x02" { $return = $item[0]; 1; }
Redirect: "\x03" { $return = $item[0]; 1; }
Reply: "\x04" { $return = $item[0]; 1; }
Disconnect: "\x05" { $return = $item[0]; 1; }
Push: "\x06" { $return = $item[0]; 1; }
ConfirmedPush: "\x07" { $return = $item[0]; 1; }
Suspend: "\x08" { $return = $item[0]; 1; }
Resume: "\x09" { $return = $item[0]; 1; }
Unassigned: /[\x10-\x3f]/ { $return = $item[0]; 1; }
Get: "\x40" { $return = $item[0]; 1; }
Options_GetPDU: "\x41" { $return = $item[0]; 1; }
Head_GetPDU: "\x42" { $return = $item[0]; 1; }
Delete_GetPDU: "\x43" { $return = $item[0]; 1; }
Trace_GetPDU: "\x44" { $return = $item[0]; 1; }
Unassigned_GetPDU: /[\x45-\x4f]/ { $return = $item[0]; 1; }
ExtendedMethod_GetPDU: /[\x50-\x5f]/ { $return = $item[0]; 1; }
Post: "\x60" { $return = $item[0]; 1; }
Put_PostPDU: "\x61" { $return = $item[0]; 1; }
Unassigned_PostPDU: /[\x62-\x6f]/ { $return = $item[0]; 1; }
ExtendedMethod_PostPDU: /[\x70-\x7f]/ { $return = $item[0]; 1; }
DataFragmentPDU: "\x80" { $return = $item[0]; 1; }
# 8.4.2.1 Basic rules
text_string: quote(?) TEXT(?) end_of_string {
   $return = scalar @{$item[2]} ? $item[2][0] : '';
   1;
}
#
token_text: token end_of_string { $return = $item{token}; 1; }
#
quoted_string: "\x22" TEXT(?) end_of_string {
   $return = scalar @{$item[2]} ? $item[2][0] : '';
   1; 
}
#
extension_media: TEXT(?) end_of_string {
   $return = scalar @{$item[1]} ? $item[1][0] : '';
   1;
}
#
short_integer:  HIGHOCTET  { $return = ord($item{HIGHOCTET}) & 0x7F; 1; }
#
long_integer:  short_length {
   my $len = $item{short_length};
   if ($len >= 1 && $len <= 30 && $len <= length $text) {
      $return = 0;
      my $chunk = substr $text, 0, $len;
      $text = substr $text, $len;
      for my $char ( split //, $chunk ) {
         $return = ($return << 8) | ord $char;
      }
      1;
   }
   else { undef; } # Reject
}
#
# multi_octet_integer buried inside long_integer
#
uintvar_integer: uintvar
#
constrained_encoding: extension_media | short_integer
#
quote:          "\x7F"
#
end_of_string:  "\x00"
#
#
# 8.4.2.2 Length
#
value_length: short_length | long_length
#
short_length:  uint8 {
   if ($item[1] <= 30) {
      $return = $item[1];
      1;
   }
   else { undef } # Reject
}
#
length_quote: "\x1F"
#
length_: uintvar
long_length: length_quote length_
# 8.4.2.3 Parameter Values
#
no_value: "\x00" { $return = ''; 1; }
#
text_value: no_value | token_text | quoted_string
#
integer_value: short_integer | long_integer
#
date_value: long_integer
#
delta_seconds_value: integer_value
#
q_value: HIGHOCTET(?) CHAR {
   my $value = 0;
   $value = (ord($item[1][0]) & 0x7F) << 7 if scalar @{$item[1]};
   $value |= ord($item[2]);
   if ($value <= 100) {
      $return = ($value - 1) / 100;
   }
   else {
      $return = ($value - 100) / 1000;
   }
   if ($return >= 1) {
      $return = undef;
   }
   else {
      1;
   }
}
#
version_value: _short_integer_version | text_string
#
_short_integer_version: short_integer {
   my $version = $item{short_integer};
   $return = ($version >> 4) & 0x07;
   my $minor = $version & 0x0F;
   $return .= ".$minor" if $minor < 15;
   1;
}
#
uri_value: text_string
#
#
# 8.4.2.4 Parameter
#
parameter: typed_parameter | untyped_parameter
#
# expand   typed_parameter: well_known_parameter_token typed_value
typed_parameter: q_parameter
   | charset_parameter
   | level_parameter
   | type_parameter
   | name_deprecated_parameter
   | filename_deprecated_parameter
   | differences_parameter
   | padding_parameter
   | type_related_parameter
   | start_related_deprecated_parameter
   | start_info_related_deprecated_parameter
   | comment_deprecated_parameter
   | domain_deprecated_parameter
   | max_age_parameter
   | path_deprecated_parameter
   | secure_parameter
   | SEC_wbxml_parameter
   | MAC_wbxml_parameter
   | creation_date_parameter
   | modification_date_parameter
   | read_date_parameter
   | size_parameter
   | name_parameter
   | filename_parameter
   | start_related_parameter
   | start_info_related_parameter
   | comment_parameter
   | domain_parameter
   | path_parameter
# Parameter definition, build_parameter() defined in g-startup.pl
# following fields: name, value, encoding
q_parameter: "\x80" q_value 
   { $return = build_parameter(@item, '1.1'); 1; }
charset_parameter: "\x81" well_known_charset
   { $return = build_parameter(@item, '1.1'); 1; }
level_parameter: "\x82" version_value
   { $return = build_parameter(@item, '1.1'); 1; }
type_parameter: "\x83" integer_value
   { $return = build_parameter(@item, '1.1'); 1; }
name_deprecated_parameter: "\x85" text_string
   { $return = build_parameter(@item, '1.1'); 1; }
filename_deprecated_parameter: "\x86" text_string
   { $return = build_parameter(@item, '1.1'); 1; }
differences_parameter: "\x87" field_name
   { $return = build_parameter(@item, '1.1'); 1; }
padding_parameter: "\x88" short_integer
   { $return = build_parameter(@item, '1.1'); 1; }
type_related_parameter: "\x89" constrained_encoding
   { $return = build_parameter(@item, '1.2'); 1; }
start_related_deprecated_parameter: "\x8a" text_string
   { $return = build_parameter(@item, '1.2'); 1; }
start_info_related_deprecated_parameter: "\x8b" text_string
   { $return = build_parameter(@item, '1.2'); 1; }
comment_deprecated_parameter: "\x8c" text_string
   { $return = build_parameter(@item, '1.3'); 1; }
domain_deprecated_parameter: "\x8d" text_string
   { $return = build_parameter(@item, '1.3'); 1; }
max_age_parameter: "\x8e" delta_seconds_value
   { $return = build_parameter(@item, '1.3'); 1; }
path_deprecated_parameter: "\x8f" text_string
   { $return = build_parameter(@item, '1.3'); 1; }
secure_parameter: "\x90" no_value
   { $return = build_parameter(@item, '1.3'); 1; }
SEC_wbxml_parameter: "\x91" short_integer
   { $return = build_parameter(@item, '1.4'); 1; }
MAC_wbxml_parameter: "\x92" text_value
   { $return = build_parameter(@item, '1.4'); 1; }
creation_date_parameter: "\x93" date_value
   { $return = build_parameter(@item, '1.4'); 1; }
modification_date_parameter: "\x94" date_value
   { $return = build_parameter(@item, '1.4'); 1; }
read_date_parameter: "\x95" date_value
   { $return = build_parameter(@item, '1.4'); 1; }
size_parameter: "\x96" integer_value
   { $return = build_parameter(@item, '1.4'); 1; }
name_parameter: "\x97" text_value
   { $return = build_parameter(@item, '1.4'); 1; }
filename_parameter: "\x98" text_value
   { $return = build_parameter(@item, '1.4'); 1; }
start_related_parameter: "\x99" text_value
   { $return = build_parameter(@item, '1.4'); 1; }
start_info_related_parameter: "\x9a" text_value
   { $return = build_parameter(@item, '1.4'); 1; }
comment_parameter: "\x9b" text_value
   { $return = build_parameter(@item, '1.4'); 1; }
domain_parameter: "\x9c" text_value
   { $return = build_parameter(@item, '1.4'); 1; }
path_parameter: "\x9d" text_value
   { $return = build_parameter(@item, '1.4'); 1; }
# Actually unused, have expanded all above with correct codes
typed_value: compact_value | text_value
#
compact_value: integer_value
   | date_value | delta_seconds_value | q_value | version_value
   | uri_value
# Back to usefulness
untyped_parameter: token_text untyped_value {
   $return = { name => $item[1], value => $item[2] };
   1;
}
#
untyped_value: integer_value | text_value
# Content-Type and its family
content_type_value: ct_constrained_media | content_general_form
ct_constrained_media: constrained_media {
   $return = { text => $item[1], media_type => $item[1], parameters => {} };
   1;
}
content_general_form: value_length {
   my $len = $item[1];
   if ($len <= length $text) {
      my $ctdata = substr $text, 0, $len;
      $text = substr $text, $len;
      $return = $thisparser->_media_type($ctdata);
      defined($return)|| undef;
   }
   else { undef }
}
_media_type: ( _trans_well_known_media | extension_media ) parameter(s?) {
   my $media_type = $item[1];
   if (defined $media_type) {
      my @parameters = map { # param_encode() defined in g-startup.pl
         $_->{name} . ' = ' . param_encode($_->{value});
      } @{$item[2]};
      my %parameters = map { $_->{name} => $_->{value} } @{$item[2]};
      my $text = join '; ', $media_type, @parameters;
      $return = {
         text => $text,
         media_type => $media_type,
         parameters => \%parameters,
      };
      1;
   }
   else {undef}
}
media_type: _media_type {
   my $media_type = $item[1] || {};
   $return = $media_type->{text};
   defined($return);
}
_trans_well_known_media: well_known_media {
   # media_type_for() defined in g-startup.pl
   $return = media_type_for($item{well_known_media});
   1;
}
# Spurious definition, eventually integrated elsewhere
well_known_charset: any_charset | _well_known_charset_wcode
_well_known_charset_wcode: integer_value {
   my %name_for = (
      0x07ea => 'big5',
      0x03e8 => 'iso-10646-ucs-2',
      0x04 => 'iso-8859-1',
      0x05 => 'iso-8859-2',
      0x06 => 'iso-8859-3',
      0x07 => 'iso-8859-4',
      0x08 => 'iso-8859-5',
      0x09 => 'iso-8859-6',
      0x0a => 'iso-8859-7',
      0x0b => 'iso-8859-8',
      0x0c => 'iso-8859-9',
      0x11 => 'shift_JIS',
      0x03 => 'us-ascii',
      0x6a => 'utf-8',
   );
   $return = $item[1];
   $return = $name_for{$return} if exists $name_for{$return};
   1;
}
any_charset: "\x80" { $return = '*'; 1; }
field_name: token_text | well_known_field_name
well_known_field_name: short_integer
constrained_media: constrained_encoding
well_known_media: integer_value
#
# Multipart
#
multipart: multipart_header multipart_entry(s)
multipart_header: uintvar
multipart_entry: multipart_headers_len multipart_data_len {
   my ($hlen, $dlen) = @item[1,2];
   $return = {
      headers => $thisparser->multipart_headers(substr $text, 0, $hlen),
      data => substr($text, $hlen, $dlen),
   };
   $text = substr $text, $hlen + $dlen;
   1;
}
multipart_headers_len: uintvar
multipart_data_len: uintvar
multipart_headers: content_type_value {
   $return = {
      content_type => $item[1],
      other_headers => $text,
   };
   1;
}