← Back to branch summary

~ubuntu-branches/debian/sid/libembperl-perl/sid

« back to all changes in this revision

Viewing changes to xsbuilder/TypeMap.pm

  • Committer: Bazaar Package Importer
  • Author(s): Angus Lees
  • Date: 2004-02-15 14:23:39 UTC
  • Revision ID: james.westby@ubuntu.com-20040215142339-f2pqlcugymgn16bq
Tags: 2.0b10-1
http://bugs.debian.org/229917
http://bugs.debian.org/229922
* New upstream release.
* Extend Dependencies to include libcgi-pm-perl | perl-modules (>= 5.8.0).
* Goswin von Brederlow:
 - test.pl: Progressively sleep longer till apache gets started
   on slow or loaded systems. Hopefully fixes m68k build failure.
   Closes: #229917
 - Build for all archs again since they keep libembperl-perl out of
   testing anyway and maybe someone can track it down.
* Include bugfixes from Embperl CVS:
 - fix Validate JS code
 - fix endless loop with call sub inside table
 - fix select without name dynamic loop
 - fix nesting of tab and select
 - fix upload with CGI 3.01+ (perl 5.8.3)
* Remove more files during clean, closes: #229922.

Show diffs side-by-side

added added

removed removed

Lines of Context:
xsbuilder/TypeMap.pm
 
1
package Embperl::TypeMap;
 
2
 
 
3
use strict;
 
4
use warnings;
 
5
 
 
6
use base qw(ExtUtils::XSBuilder::TypeMap);
 
7
 
 
8
sub map_structure {
 
9
  my ($self, $struct) = @_;
 
10
 
 
11
  my %fixedsize;
 
12
 
 
13
  foreach my $e ( @{$struct->{elts}} ) {
 
14
    $e->{name} =~ s/\[(.*)\]// or next;
 
15
    $fixedsize{$e->{name}} = $1;
 
16
    $e->{type} .= ' *';
 
17
  }
 
18
 
 
19
  my $mapped = $self->SUPER::map_structure($struct);
 
20
 
 
21
  foreach my $e (@{$mapped->{elts}}) {
 
22
    my $nitems = $fixedsize{$e->{name}} or next;
 
23
    if ($e->{type} eq 'char *') {
 
24
      $e->{malloc} = "strncpy(\$dest, \$src, $nitems-1)";
 
25
      undef $e->{free};
 
26
    } else {
 
27
      # FIXME: need to copy MIN($e->{nitems}, num_given_in_the_first_place)
 
28
      $e->{malloc} = "Copy(\$src, \$dest, $nitems, \$type)";
 
29
      undef $e->{free};
 
30
      warn "WARNING: don't know how to copy $e->{name}";
 
31
    }
 
32
  }
 
33
 
 
34
  $mapped;
 
35
}
 
36
 
 
37
1;