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 BEGIN { use_ok('SDBM_File') };
  25 BEGIN { use_ok('Fcntl') };
  26 BEGIN { use_ok('charnames', qw{greek})};
  27
  28 use charnames qw{greek};
  29
  30 unlink <Op_dbmx*>;
  31 END { unlink <Op_dbmx*>; }
  32
  33 my %h1 = () ;
  34 my $db1 = tie(%h1, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
  35
  36 ok $db1, "tied to SDBM_File";
  37
  38 eval { $db1->Filter_Push('encode' => 'blah') };
  39 like $@, qr/^Encoding 'blah' is not available/, "push an illigal filter" ;
  40
  41 eval { $db1->Filter_Push('encode') };
  42 is $@, '', "push an 'encode' filter (default to utf-8)" ;
  43
  44
  45 {
  46     no warnings 'uninitialized';
  47     StoreData(\%h1,
  48         {
  49                 undef() => undef(),
  50                 'alpha' => "\N{alpha}",
  51                 "\N{gamma}"=> "gamma",
  52                 "beta"  => "\N{beta}",
  53         });
  54
  55 }
  56
  57 VerifyData(\%h1,
  58         {
  59                 'alpha' => "\N{alpha}",
  60                 "beta"  => "\N{beta}",
  61                 "\N{gamma}"=> "gamma",
  62                 ""              => "",
  63         });
  64
  65 eval { $db1->Filter_Pop() };
  66 is $@, '', "pop the 'utf8' filter" ;
  67
  68 eval { $db1->Filter_Push('encode' => 'iso-8859-16') };
  69 is $@, '', "push an 'encode' filter (specify iso-8859-16)" ;
  70
  71 use charnames qw{:full};
  72 StoreData(\%h1,
  73         {
  74                 'euro'  => "\N{EURO SIGN}",
  75         });
  76
  77 undef $db1;
  78 {
  79     use warnings FATAL => 'untie';
  80     eval { untie %h1 };
  81     is $@, '', "untie without inner references" ;
  82 }
  83
  84 # read the dbm file without the filter
  85 my %h2 = () ;
  86 my $db2 = tie(%h2, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
  87
  88 ok $db2, "tied to SDBM_File";
  89
  90 VerifyData(\%h2,
  91         {
  92                 'alpha' => "\xCE\xB1",
  93                 'beta'  => "\xCE\xB2",
  94                 "\xCE\xB3"=> "gamma",
  95                 'euro'  => "\xA4",
  96                 ""              => "",
  97         });
  98
  99 undef $db2;
 100 {
 101     use warnings FATAL => 'untie';
 102     eval { untie %h2 };
 103     is $@, '', "untie without inner references" ;
 104 }
 105