lib/DBM_Filter/t/encode.t

   1
   2 use strict;
   3 use warnings;
   4 use Carp;
   5
   6
   7 BEGIN
   8 {
   9
  10     eval { require Encode; };
  11
  12     if ($@) {
  13         print "1..0 #  Skip: Encode is not available\n";
  14         exit 0;
  15     }
  16 }
  17
  18
  19 require "dbm_filter_util.pl";
  20
  21 use Test::More tests => 26;
  22
  23 BEGIN { use_ok('DBM_Filter') };
  24 my $db_file;
  25 BEGIN {
  26     use Config;
  27     foreach (qw/SDBM_File ODBM_File NDBM_File GDBM_File DB_File/) {
  28         if ($Config{extensions} =~ /\b$_\b/) {
  29             $db_file = $_;
  30             last;
  31         }
  32     }
  33     use_ok($db_file);
  34 };
  35 BEGIN { use_ok('Fcntl') };
  36 BEGIN { use_ok('charnames', qw{greek})};
  37
  38 use charnames qw{greek};
  39
  40 unlink <Op_dbmx*>;
  41 END { unlink <Op_dbmx*>; }
  42
  43 my %h1 = () ;
  44 my $db1 = tie(%h1, $db_file,'Op_dbmx', O_RDWR|O_CREAT, 0640) ;
  45
  46 ok $db1, "tied to $db_file";
  47
  48 eval { $db1->Filter_Push('encode' => 'blah') };
  49 like $@, qr/^Encoding 'blah' is not available/, "push an illegal filter" ;
  50
  51 eval { $db1->Filter_Push('encode') };
  52 is $@, '', "push an 'encode' filter (default to utf-8)" ;
  53
  54
  55 {
  56     no warnings 'uninitialized';
  57     StoreData(\%h1,
  58         {
  59                 undef() => undef(),
  60                 'alpha' => "\N{alpha}",
  61                 "\N{gamma}"=> "gamma",
  62                 "beta"  => "\N{beta}",
  63         });
  64
  65 }
  66
  67 VerifyData(\%h1,
  68         {
  69                 'alpha' => "\N{alpha}",
  70                 "beta"  => "\N{beta}",
  71                 "\N{gamma}"=> "gamma",
  72                 ""              => "",
  73         });
  74
  75 eval { $db1->Filter_Pop() };
  76 is $@, '', "pop the 'utf8' filter" ;
  77
  78 eval { $db1->Filter_Push('encode' => 'iso-8859-16') };
  79 is $@, '', "push an 'encode' filter (specify iso-8859-16)" ;
  80
  81 use charnames qw{:full};
  82 StoreData(\%h1,
  83         {
  84                 'euro'  => "\N{EURO SIGN}",
  85         });
  86
  87 undef $db1;
  88 {
  89     use warnings FATAL => 'untie';
  90     eval { untie %h1 };
  91     is $@, '', "untie without inner references" ;
  92 }
  93
  94 # read the dbm file without the filter
  95 my %h2 = () ;
  96 my $db2 = tie(%h2, $db_file,'Op_dbmx', O_RDWR|O_CREAT, 0640) ;
  97
  98 ok $db2, "tied to $db_file";
  99
 100 if (ord('A') == 193) { # EBCDIC.
 101     VerifyData(\%h2,
 102            {
 103             'alpha'     => "\xB4\x58",
 104             'beta'      => "\xB4\x59",
 105             "\xB4\x62"=> "gamma",
 106             "\x65\x75\x72\x6F" => "\xA4",
 107             ""          => "",
 108            });
 109 } else {
 110     VerifyData(\%h2,
 111            {
 112             'alpha'     => "\xCE\xB1",
 113             'beta'      => "\xCE\xB2",
 114             "\xCE\xB3"=> "gamma",
 115             'euro'      => "\xA4",
 116             ""          => "",
 117            });
 118 }
 119
 120 undef $db2;
 121 {
 122     use warnings FATAL => 'untie';
 123     eval { untie %h2 };
 124     is $@, '', "untie without inner references" ;
 125 }
 126