/[cvs]/nfo/perl/libs/Data/Mungle/Transform/Encode.pm
ViewVC logotype

Diff of /nfo/perl/libs/Data/Mungle/Transform/Encode.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by joko, Thu Dec 5 13:57:22 2002 UTC revision 1.5 by joko, Wed Apr 9 07:22:34 2003 UTC
# Line 1  Line 1 
1  ##############################################  ## -------------------------------------------------------------------------
2  #  ##  $Id$
3  #  $Id$  ## -------------------------------------------------------------------------
4  #  ##  $Log$
5  #  $Log$  ##  Revision 1.5  2003/04/09 07:22:34  joko
6  #  Revision 1.2  2002/12/05 13:57:22  joko  ##  childObj2string now inside Encode.pm, renamed to 'twingle_reference'
7  #  + now able to export 'scalar2utf8'  ##
8  #  + comments  ##  Revision 1.4  2003/03/27 15:17:07  joko
9  #  ##  namespace fixes for Data::Mungle::*
10  #  Revision 1.1  2002/11/29 04:49:20  joko  ##
11  #  + initial check-in  ##  Revision 1.3  2003/02/20 20:48:36  joko
12  #  ##  renamed methods
13  #  Revision 1.1  2002/10/10 03:26:00  cvsjoko  ##
14  #  + new  ##  Revision 1.2  2002/12/05 13:57:22  joko
15  #  ##  + now able to export 'scalar2utf8'
16  ##############################################  ##  + comments
17    ##
18    ##  Revision 1.1  2002/11/29 04:49:20  joko
19    ##  + initial check-in
20    ##
21    ##  Revision 1.1  2002/10/10 03:26:00  cvsjoko
22    ##  + new
23    ## -------------------------------------------------------------------------
24    
25    
26  package Data::Transform::Encode;  package Data::Mungle::Transform::Encode;
27    
28  use strict;  use strict;
29  use warnings;  use warnings;
30    
31  require Exporter;  require Exporter;
32  our @ISA = qw( Exporter );  our @ISA = qw( Exporter );
33  our @EXPORT_OK = qw( &var2utf8 &var_utf2iso &scalar2utf8 );  our @EXPORT_OK = qw(
34      &latin_to_utf8
35      &latin_to_utf8_scalar
36      &utf8_to_latin
37      &utf8_to_latin_scalar
38      &twingle_reference
39    );
40    
41    
42  use Unicode::String qw(utf8 latin1);  use Unicode::String qw(utf8 latin1);
43    
44  # TODO: refactor using Greg London's "Iterate" from CPAN  # TODO: refactor using Greg London's "Iterate" from CPAN
45  sub var2utf8 {  sub latin_to_utf8 {
46    my $vref = shift;    my $vref = shift;
47    if (ref $vref eq 'HASH') {    if (ref $vref eq 'HASH') {
48      foreach (keys %{$vref}) {      foreach (keys %{$vref}) {
49        if ((ref $vref->{$_}) =~ m/ARRAY|HASH/) {        if ((ref $vref->{$_}) =~ m/ARRAY|HASH/) {
50          var2utf8($vref->{$_});          latin_to_utf8($vref->{$_});
51        } else {        } else {
52          $vref->{$_} = scalar2utf8($vref->{$_});          $vref->{$_} = latin_to_utf8_scalar($vref->{$_});
53        }        }
54      }      }
55    } elsif (ref $vref eq 'ARRAY') {    } elsif (ref $vref eq 'ARRAY') {
56      foreach (@{$vref}) {      foreach (@{$vref}) {
57        if (ref $_ ne 'SCALAR') {        if (ref $_ ne 'SCALAR') {
58          var2utf8($_);          latin_to_utf8($_);
59        } else {        } else {
60          $_ = scalar2utf8($_);          $_ = latin_to_utf8_scalar($_);
61        }        }
62      }      }
63    }    }
64        
65  }  }
66    
67  sub scalar2utf8 {  sub latin_to_utf8_scalar {
68    my $scalar = shift;    my $scalar = shift;
69    if ($scalar) {    if ($scalar) {
70      my $u = latin1($scalar);      my $u = latin1($scalar);
# Line 59  sub scalar2utf8 { Line 73  sub scalar2utf8 {
73  }  }
74    
75  # TODO: refactor using Greg London's "Iterate" from CPAN  # TODO: refactor using Greg London's "Iterate" from CPAN
76  sub var_utf2iso {  sub utf8_to_latin {
77    my $vref = shift;    my $vref = shift;
78    if (ref $vref eq 'HASH') {    if (ref $vref eq 'HASH') {
79      foreach (keys %{$vref}) {      foreach (keys %{$vref}) {
80        if ((ref $vref->{$_}) =~ m/ARRAY|HASH/) {        if ((ref $vref->{$_}) =~ m/ARRAY|HASH/) {
81          var_utf2iso($vref->{$_});          utf8_to_latin($vref->{$_});
82        } else {        } else {
83          $vref->{$_} = scalar2iso($vref->{$_});          $vref->{$_} = utf8_to_latin_scalar($vref->{$_});
84        }        }
85      }      }
86    } elsif (ref $vref eq 'ARRAY') {    } elsif (ref $vref eq 'ARRAY') {
87      foreach (@{$vref}) {      foreach (@{$vref}) {
88        if (ref $_ ne 'SCALAR') {        if (ref $_ ne 'SCALAR') {
89          var_utf2iso($_);          utf8_to_latin($_);
90        } else {        } else {
91          $_ = scalar2iso($_);          $_ = utf8_to_latin_scalar($_);
92        }        }
93      }      }
94    }    }
95        
96  }  }
97    
98  sub scalar2iso {  sub utf8_to_latin_scalar {
99    my $scalar = shift;    my $scalar = shift;
100    if ($scalar) {    if ($scalar) {
101      my $u = utf8($scalar);      my $u = utf8($scalar);
# Line 89  sub scalar2iso { Line 103  sub scalar2iso {
103    }    }
104  }  }
105    
106    
107    # encodes object-references to serialized string representations
108    # made up of:
109    #   - 'o_<classname>_<ref type>_<guid>'???
110    #   - 'o_{guid}_{classname}'!!!
111    
112    # TODO: enhance further!
113    # make it possible to twingle OID-, GUID- and/or other references
114    
115    sub twingle_reference {
116      my $obj = shift;
117      my $option = shift;
118      my $string = 'n/a';
119      
120      #if ($option == 1) {
121        if ((my $classname = ref $obj) && (my $guid = $obj->{guid})) {
122          $string = join('_', 'o', $guid, $classname);
123        }  
124      #}
125      
126      return $string;
127    }
128    
129    
130  1;  1;
131    __END__
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.5
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed