Debian/Debhelper/config_package.pm

   1 #!/usr/bin/perl
   2
   3 package Debian::Debhelper::config_package;
   4
   5 use warnings;
   6 use strict;
   7
   8 use Exporter;
   9 use vars qw(@ISA @EXPORT);
  10 @ISA=qw(Exporter);
  11 @EXPORT=qw(&encode &decode);
  12
  13 sub encode {
  14     my $result = "";
  15     my $input = shift;
  16     $input =~ s,^/,,;
  17     foreach (split('', $input)) {
  18         if (m/[a-z0-9.-]/) {
  19             $result .= "$_";
  20         } elsif (m/[A-Z]/) {
  21             $result .= "+".lc($_)."+";
  22         } elsif ($_ eq '/') {
  23             $result .= "++";
  24         } elsif ($_ eq '_') {
  25             $result .= "+-+";
  26         } else{
  27             $result .= "+x".hex(ord($_))."+";
  28         }
  29     }
  30     return $result;
  31 }
  32
  33 sub unparse {
  34     $_ = $_[0];
  35     return "/" unless $_;
  36     return "_" if $_ eq "-";
  37     return uc($_) if /^[a-z]$/;
  38     s/^x//;
  39     return chr hex $_;
  40 }
  41
  42 sub decode {
  43     my $input = shift;
  44     $input =~ s/\+([^+]*)\+/unparse($1)/eg;
  45     return $input;
  46 }
  47
  48 1