--- nfo/perl/libs/Data/Mungle/Transform/Encode.pm 2002/12/05 13:57:22 1.2 +++ nfo/perl/libs/Data/Mungle/Transform/Encode.pm 2003/04/09 07:22:34 1.5 @@ -1,56 +1,70 @@ -############################################## -# -# $Id: Encode.pm,v 1.2 2002/12/05 13:57:22 joko Exp $ -# -# $Log: Encode.pm,v $ -# Revision 1.2 2002/12/05 13:57:22 joko -# + now able to export 'scalar2utf8' -# + comments -# -# Revision 1.1 2002/11/29 04:49:20 joko -# + initial check-in -# -# Revision 1.1 2002/10/10 03:26:00 cvsjoko -# + new -# -############################################## +## ------------------------------------------------------------------------- +## $Id: Encode.pm,v 1.5 2003/04/09 07:22:34 joko Exp $ +## ------------------------------------------------------------------------- +## $Log: Encode.pm,v $ +## Revision 1.5 2003/04/09 07:22:34 joko +## childObj2string now inside Encode.pm, renamed to 'twingle_reference' +## +## Revision 1.4 2003/03/27 15:17:07 joko +## namespace fixes for Data::Mungle::* +## +## Revision 1.3 2003/02/20 20:48:36 joko +## renamed methods +## +## Revision 1.2 2002/12/05 13:57:22 joko +## + now able to export 'scalar2utf8' +## + comments +## +## Revision 1.1 2002/11/29 04:49:20 joko +## + initial check-in +## +## Revision 1.1 2002/10/10 03:26:00 cvsjoko +## + new +## ------------------------------------------------------------------------- -package Data::Transform::Encode; +package Data::Mungle::Transform::Encode; use strict; use warnings; require Exporter; our @ISA = qw( Exporter ); -our @EXPORT_OK = qw( &var2utf8 &var_utf2iso &scalar2utf8 ); +our @EXPORT_OK = qw( + &latin_to_utf8 + &latin_to_utf8_scalar + &utf8_to_latin + &utf8_to_latin_scalar + &twingle_reference +); + use Unicode::String qw(utf8 latin1); # TODO: refactor using Greg London's "Iterate" from CPAN -sub var2utf8 { +sub latin_to_utf8 { my $vref = shift; if (ref $vref eq 'HASH') { foreach (keys %{$vref}) { if ((ref $vref->{$_}) =~ m/ARRAY|HASH/) { - var2utf8($vref->{$_}); + latin_to_utf8($vref->{$_}); } else { - $vref->{$_} = scalar2utf8($vref->{$_}); + $vref->{$_} = latin_to_utf8_scalar($vref->{$_}); } } } elsif (ref $vref eq 'ARRAY') { foreach (@{$vref}) { if (ref $_ ne 'SCALAR') { - var2utf8($_); + latin_to_utf8($_); } else { - $_ = scalar2utf8($_); + $_ = latin_to_utf8_scalar($_); } } } } -sub scalar2utf8 { +sub latin_to_utf8_scalar { my $scalar = shift; if ($scalar) { my $u = latin1($scalar); @@ -59,29 +73,29 @@ } # TODO: refactor using Greg London's "Iterate" from CPAN -sub var_utf2iso { +sub utf8_to_latin { my $vref = shift; if (ref $vref eq 'HASH') { foreach (keys %{$vref}) { if ((ref $vref->{$_}) =~ m/ARRAY|HASH/) { - var_utf2iso($vref->{$_}); + utf8_to_latin($vref->{$_}); } else { - $vref->{$_} = scalar2iso($vref->{$_}); + $vref->{$_} = utf8_to_latin_scalar($vref->{$_}); } } } elsif (ref $vref eq 'ARRAY') { foreach (@{$vref}) { if (ref $_ ne 'SCALAR') { - var_utf2iso($_); + utf8_to_latin($_); } else { - $_ = scalar2iso($_); + $_ = utf8_to_latin_scalar($_); } } } } -sub scalar2iso { +sub utf8_to_latin_scalar { my $scalar = shift; if ($scalar) { my $u = utf8($scalar); @@ -89,4 +103,29 @@ } } + +# encodes object-references to serialized string representations +# made up of: +# - 'o___'??? +# - 'o_{guid}_{classname}'!!! + +# TODO: enhance further! +# make it possible to twingle OID-, GUID- and/or other references + +sub twingle_reference { + my $obj = shift; + my $option = shift; + my $string = 'n/a'; + + #if ($option == 1) { + if ((my $classname = ref $obj) && (my $guid = $obj->{guid})) { + $string = join('_', 'o', $guid, $classname); + } + #} + + return $string; +} + + 1; +__END__