1# FIXME: this is very SLOW!!! 2 3package stkutils::data_packet; 4use strict; 5 6sub new { 7 my $class = shift; 8 my $data = shift; 9 my $self = {}; 10 $self->{data} = ($data or ''); 11 $self->{init_length} = CORE::length($self->{data}); 12 bless($self, $class); 13 return $self; 14} 15sub unpack { 16 my $self = shift; 17 my $template = shift; 18die if !(defined $self); 19die if !(defined $self->{data}); 20die if !(defined $template); 21die if CORE::length($self->{data}) == 0; 22 my @values = CORE::unpack($template.'a*', $self->{data}); 23die if $#values == -1; 24 $self->{data} = splice(@values, -1); 25die if !(defined $self->{data}); 26 return @values; 27} 28sub pack { 29 my $self = shift; 30 my $template = shift; 31die if !(defined($template)); 32die if !(defined(@_)); 33die unless defined $_[0]; 34 $self->{data} .= CORE::pack($template, @_); 35} 36use constant template_for_scalar => { 37 h32 => 'V', 38 h16 => 'v', 39 h8 => 'C', 40 u32 => 'V', 41 u16 => 'v', 42 u8 => 'C', 43 q8 => 'C', 44 s32 => 'l', 45 s16 => 'v', 46 s8 => 'C', 47 sz => 'Z*', 48 f32 => 'f', 49 guid => 'a[16]', 50}; 51use constant template_for_vector => { 52 l8u8v => 'C/C', 53 l32u8v => 'V/C', 54 l32u16v => 'V/v', 55 l32szv => 'V/(Z*)', 56 l8szbv => 'C/(Z*C)', 57 u8v8 => 'C8', 58 u8v4 => 'C4', 59 f32v3 => 'f3', 60 f32v4 => 'f4', 61 s32v3 => 'l3', 62 s32v4 => 'l4', 63}; 64sub unpack_properties { 65 my $self = shift; 66 my $container = shift; 67 68 foreach my $p (@_) { 69 #print "unpacking $p->{name} type $p->{type}\n"; 70 if ($p->{type} eq 'shape') { 71 my ($count) = $self->unpack('C'); 72 while ($count--) { 73 my %shape; 74 ($shape{type}) = $self->unpack('C'); 75 if ($shape{type} == 0) { 76 @{$shape{sphere}} = $self->unpack('f4'); 77 } elsif ($shape{type} == 1) { 78 @{$shape{box}} = $self->unpack('f12'); 79 } else { 80 die; 81 } 82 push @{$container->{$p->{name}}}, \%shape; 83 } 84 } else { 85 my $template = template_for_scalar->{$p->{type}}; 86 if (defined $template) { 87 ($container->{$p->{name}}) = $self->unpack($template); 88 if ($p->{type} eq 'sz') { 89 chomp $container->{$p->{name}}; 90 $container->{$p->{name}} =~ s/\r//g; 91 } 92 } elsif ($p->{type} eq 'u24') { 93 ($container->{$p->{name}}) = CORE::unpack('V', CORE::pack('CCCC', $self->unpack('C3'), 0)); 94 } else { 95 @{$container->{$p->{name}}} = $self->unpack(template_for_vector->{$p->{type}}); 96 } 97 } 98 } 99} 100sub pack_properties { 101 my $self = shift; 102 my $container = shift; 103 104 foreach my $p (@_) { 105 my $template = template_for_scalar->{$p->{type}}; 106 if (defined $template) { 107 $self->pack($template, $container->{$p->{name}}); 108 } elsif ($p->{type} eq 'shape') { 109 $self->pack('C', $#{$container->{$p->{name}}} + 1); 110 foreach my $shape (@{$container->{$p->{name}}}) { 111 $self->pack('C', $$shape{type}); 112 if ($$shape{type} == 0) { 113 $self->pack('f4', @{$$shape{sphere}}); 114 } elsif ($$shape{type} == 1) { 115 $self->pack('f12', @{$$shape{box}}); 116 } 117 } 118 } else { 119 my $n = $#{$container->{$p->{name}}} + 1; 120 if ($p->{type} eq 'l32u16v') { 121 $self->pack("Vv$n", $n, @{$container->{$p->{name}}}); 122 } elsif ($p->{type} eq 'l32u8v') { 123 $self->pack("VC$n", $n, @{$container->{$p->{name}}}); 124 } elsif ($p->{type} eq 'l32szv') { 125 $self->pack("V(Z*)$n", $n, @{$container->{$p->{name}}}); 126 } elsif ($p->{type} eq 'l8u8v') { 127 $self->pack("CC$n", $n, @{$container->{$p->{name}}}); 128 } elsif ($p->{type} eq 'u8v8' or $p->{type} eq 'u8v4') { 129 $self->pack("C$n", @{$container->{$p->{name}}}); 130 } elsif ($p->{type} eq 'f32v3') { 131 $self->pack('f3', @{$container->{$p->{name}}}); 132 } elsif ($p->{type} eq 'f32v4') { 133 $self->pack('f4', @{$container->{$p->{name}}}); 134 } elsif ($p->{type} eq 's32v3') { 135 $self->pack('l3', @{$container->{$p->{name}}}); 136 } elsif ($p->{type} eq 's32v4') { 137 $self->pack('l4', @{$container->{$p->{name}}}); 138 } elsif ($p->{type} eq 'q8v') { 139 $self->pack("C$n", @{$container->{$p->{name}}}); 140 } elsif ($p->{type} eq 'l8szbv') { 141 $self->pack("C(Z*C)$n", $n/2, @{$container->{$p->{name}}}); 142 } else { 143 die; 144 } 145 } 146 } 147} 148sub length { 149 return CORE::length($_[0]->{data}); 150} 151sub r_tell { 152 return $_[0]->{init_length} - CORE::length($_[0]->{data}); 153} 154sub w_tell { 155 return CORE::length($_[0]->{data}); 156} 157sub data { 158 return $_[0]->{data}; 159} 160 1611; 162