home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Perl / ActivePerl-5.6.0.613.msi / 䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥 / _105b3743a1f1b9e0ba89a24eac3a437c < prev    next >
Encoding:
Text File  |  2000-03-15  |  3.7 KB  |  131 lines
  1. package SOAP::TypeMapper;
  2.  
  3. use SOAP::GenericScalarSerializer;
  4. use SOAP::GenericHashSerializer;
  5.  
  6. use strict;
  7. use vars qw($VERSION);
  8.  
  9. $VERSION = '0.23';
  10.  
  11. sub new {
  12.     my ($class) = @_;
  13.     
  14.     my $self = {
  15.         serializer_map   => {},
  16.         deserializer_map => {},
  17.     };
  18.     bless $self, $class;
  19. }
  20.  
  21. my $g_defaultMapper;
  22.  
  23. sub defaultMapper {
  24.     $g_defaultMapper ||= SOAP::TypeMapper->new();
  25. }
  26.  
  27. my $g_unhandled_types_for_serialization = {
  28.     REF     => "SOAP/Perl does not attempt to serialize references to references. Please simplify.",
  29.     CODE    => "SOAP/Perl does not attempt to serialize code references.",
  30.     GLOB    => "SOAP/Perl does not attempt to serialize typeglobs.",
  31. };
  32.  
  33. sub get_serializer {
  34.     my ($self, $object) = @_;
  35.  
  36. # for now, assume caller handles undef according to context
  37.     unless (defined $object) {
  38.     die "unexpected call to get_serializer with <undef>";
  39.     }
  40. #    unless (defined $object) {
  41. #    return SOAP::GenericScalarSerializer->new('');
  42. #    }
  43.     my $reftype = ref $object;
  44.     unless ($reftype) {
  45.     return SOAP::GenericScalarSerializer->new($object)
  46.     }
  47.     if (exists $g_unhandled_types_for_serialization->{$reftype}) {
  48.         die $g_unhandled_types_for_serialization->{$reftype};
  49.     }
  50.     if ('SCALAR' eq $reftype) {
  51.         return SOAP::GenericScalarSerializer->new($$object);
  52.     }
  53.     if ('HASH' eq $reftype) {
  54.         return SOAP::GenericHashSerializer->new($object);
  55.     }
  56.     elsif ('ARRAY' eq $reftype) {
  57.         die "This implementation of SOAP/Perl doesn't attempt to marshal/unmarshal arrays.";
  58.     }
  59.  
  60.     # by process of elimination, it must be a blessed object reference
  61.     # see if the object itself wants to provide its own serializer,
  62.     # otherwise do lookup in dictionary
  63.     if ($object->can('get_soap_serializer')) {
  64.         return $object->get_soap_serializer();
  65.     }
  66.     elsif (exists $self->{serializer_map}{$reftype}) {
  67.         return $self->{serializer_map}{$reftype}->($object);
  68.     }
  69.     # if all else fails, do something generic (eventually)
  70.     die "This implementation of SOAP/Perl doesn't attempt to marshal/unmarshal blessed object references.";
  71. }
  72.  
  73. sub get_deserializer {
  74.     my ($self, $typeuri, $typename, $resolver) = @_;
  75.  
  76.     $typeuri  ||= '';
  77.     $typename ||= '';
  78.  
  79.     my $map = $self->{deserializer_map};
  80.  
  81.     my $key = $typeuri . '#' . $typename;
  82.     if (exists $map->{$key}) {
  83.         return $map->{$key}->($typeuri, $typename, $resolver);
  84.     }
  85.     return SOAP::GenericInputStream->new($typeuri,
  86.                                          $typename,
  87.                                          $resolver,
  88.                                          $self);
  89. }
  90.  
  91. sub register_deserializer_factory {
  92.     my ($self, $typename, $typeuri, $factory_fcn) = @_;
  93.  
  94.     $self->{deserializer_map}{$typeuri . '#' . $typename} = $factory_fcn;
  95. }
  96.  
  97. sub register_serializer_factory {
  98.     my ($self, $reftype, $factory_fcn) = @_;
  99.  
  100.     $self->{serializer_map}{$reftype} = $factory_fcn;
  101. }
  102.  
  103. 1;
  104. __END__
  105.  
  106.  
  107. =head1 NAME
  108.  
  109. SOAP::TypeMapper - Maps Perl types to their serializer/deserializer classes
  110.  
  111. =head1 SYNOPSIS
  112.  
  113. This is an extensibility point built in to SOAP/Perl to allow for future expansion,
  114. especially with regards to the eventual development of an XML Schema-based metadata
  115. format. In the short term, you can use this extensibility point to add support
  116. for marshaling blessed object references.
  117.  
  118. This is currently an experimental feature and will be documented in more detail
  119. once we have a bit more implementation experience. Feel free to peruse the sources
  120. and use this class if you like, and send feedback.
  121.  
  122. =head1 DESCRIPTION
  123.  
  124. Forthcoming...
  125.  
  126. =head1 AUTHOR
  127.  
  128. Keith Brown
  129.  
  130. =cut
  131.