lib/DBM_Filter/t/encode.t

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