view release on metacpan or  search on metacpan

CAB/Utils.pm  view on Meta::CPAN

}

##==============================================================================
## Functions: Deep recoding
##==============================================================================

## $decoded = deep_decode($encoding,$thingy,%options)
##  + %options:
##     force    => $bool,   ##-- decode even if the utf8 flag is set
##     skipvals => \@vals,  ##-- don't decode (or recurse into)  $val (overrides $force)
##     skiprefs => \@refs,  ##-- don't decode (or recurse into) $$ref (overrides $force)
##     skippkgs => \@pkgs,  ##-- don't decode (or recurse into) anything of package $pkg (overrides $force)
sub deep_decode {
  my ($enc,$thingy,%opts) = @_;
  my %skipvals = defined($opts{skipvals}) ? (map {($_=>undef)} @{$opts{skipvals}}) : qw();
  my %skiprefs = defined($opts{skiprefs}) ? (map {($_=>undef)} @{$opts{skiprefs}}) : qw();
  my %skippkgs = defined($opts{skippkgs}) ? (map {($_=>undef)} @{$opts{skippkgs}}) : qw();
  my $force    = $opts{force};
  my @queue = (\$thingy);
  my ($ar);
  while (defined($ar=shift(@queue))) {
    if (exists($skiprefs{$ar}) || exists($skipvals{$$ar}) || (ref($$ar) && exists($skippkgs{ref($$ar)}))) {
      next;
    } elsif (UNIVERSAL::isa($$ar,'ARRAY')) {
      push(@queue, map { \$_ } @{$$ar});
    } elsif (UNIVERSAL::isa($$ar,'HASH')) {
      push(@queue, map { \$_ } values %{$$ar});
    } elsif (UNIVERSAL::isa($$ar, 'SCALAR') || UNIVERSAL::isa($$ar,'REF')) {
      push(@queue, $$ar);
    } elsif (!ref($$ar)) {
      $$ar = decode($enc,$$ar) if (defined($$ar) && ($force || !utf8::is_utf8($$ar)));
    }
  }
  return $thingy;
}

## $encoded = deep_encode($encoding,$thingy,%opts)
##  + %opts:
##     force => $bool,            ##-- encode even if the utf8 flag is NOT set
##     skipvals => \@vals,        ##-- don't encode (or recurse into)  $val (overrides $force)
##     skiprefs => \@refs,        ##-- don't encode (or recurse into) $$ref (overrides $force)
##     skippkgs => \@pkgs,        ##-- don't encode (or recurse into) anything of package $pkg (overrides $force)
sub deep_encode {
  my ($enc,$thingy,%opts) = @_;
  my %skipvals = defined($opts{skipvals}) ? (map {($_=>undef)} @{$opts{skipvals}}) : qw();
  my %skiprefs = defined($opts{skiprefs}) ? (map {($_=>undef)} @{$opts{skiprefs}}) : qw();
  my %skippkgs = defined($opts{skippkgs}) ? (map {($_=>undef)} @{$opts{skippkgs}}) : qw();
  my $force    = $opts{force};
  my @queue = (\$thingy);
  my ($ar);
  while (defined($ar=shift(@queue))) {
    if (exists($skiprefs{$ar}) || !defined($$ar) || exists($skipvals{$$ar}) || (ref($$ar) && exists($skippkgs{ref($$ar)}))) {
      next;
    } elsif (UNIVERSAL::isa($$ar,'ARRAY')) {
      push(@queue, map { \$_ } @{$$ar});
    } elsif (UNIVERSAL::isa($$ar,'HASH')) {
      push(@queue, map { \$_ } values %{$$ar});
    } elsif (UNIVERSAL::isa($$ar, 'SCALAR') || UNIVERSAL::isa($$ar,'REF')) {
      push(@queue, $$ar);
    } elsif (!ref($$ar)) {
      $$ar = encode($enc,$$ar) if (defined($$ar) && ($force || utf8::is_utf8($$ar)));
    }

CAB/Utils.pm  view on Meta::CPAN

 $decoded = deep_decode($encoding,$thingy,%options);

Perform recursive string decoding on all scalars in $thingy.
Does B<NOT> check for cyclic references.

%options:

 force    => $bool,   ##-- decode even if the utf8 flag is set
 skipvals => \@vals,  ##-- don't decode (or recurse into)  $val (overrides $force)
 skiprefs => \@refs,  ##-- don't decode (or recurse into) $$ref (overrides $force)
 skippkgs => \@pkgs,  ##-- don't decode (or recurse into) anything of package $pkg (overrides $force)


=item deep_encode

 $encoded = deep_encode($encoding,$thingy,%opts);

Perform recursive string encoding on all scalars in $thingy.
Does B<NOT> check for cyclic references.

%opts:

 force => $bool,            ##-- encode even if the utf8 flag is NOT set
 skipvals => \@vals,        ##-- don't encode (or recurse into)  $val (overrides $force)
 skiprefs => \@refs,        ##-- don't encode (or recurse into) $$ref (overrides $force)
 skippkgs => \@pkgs,        ##-- don't encode (or recurse into) anything of package $pkg (overrides $force)

=item deep_recode

 $recoded = deep_recode($from,$to,$thingy, %opts);

Wrapper for:

 deep_encode($to,deep_decode($from,$thingy,%opts),%opts);