lib/Locale/Maketext/t/03http.t

   1
   2 use Locale::Maketext;
   3
   4 use Test;
   5 BEGIN { plan tests => 87 };
   6
   7 my @in = grep m/\S/, split /\n/, q{
   8
   9 [ sv      ]  sv
  10 [ en      ]  en
  11 [ en fi   ]  en, fi
  12 [ en-us   ]  en-us
  13 [ en-us   ]  en-US
  14 [ en-us   ]  EN-US
  15
  16 [ en-au en i-klingon en-gb en-us mt-mt mt ja ]  EN-au, JA;q=0.14, i-klingon;q=0.83, en-gb;q=0.71, en-us;q=0.57, mt-mt;q=0.43, mt;q=0.29, en;q=0.86
  17 [ en-au en i-klingon en-gb en-us mt-mt mt tli ja ]  EN-au, tli;q=0.201, JA;q=0.14, i-klingon;q=0.83, en-gb;q=0.71, en-us;q=0.57, mt-mt;q=0.43, mt;q=0.29, en;q=0.86
  18 [ en-au en en-gb en-us ja  ]  en-au, ja;q=0.20, en-gb;q=0.60, en-us;q=0.40, en;q=0.80
  19
  20 [ en-au en en-gb en-us mt-mt mt ja ]  EN-au, JA;q=0.14, en-gb;q=0.71, en-us;q=0.57, mt-mt;q=0.43, mt;q=0.29, en;q=0.86
  21 [ en-au en en-gb en-us ja  ]  en-au, ja;q=0.20, en-gb;q=0.60, en-us;q=0.40, en;q=0.80
  22 [ en fr           ]  en;q=1,fr;q=.5
  23 [ en fr           ]  en;q=1,fr;q=.99
  24 [ en ru ko        ]  en, ru;q=0.7, ko;q=0.3
  25 [ en ru ko        ]  en, ru;q=0.7, KO;q=0.3
  26 [ en-us en        ]  en-us, en;q=0.50
  27 [ en fr           ]  fr ; q = 0.9, en
  28 [ en fr           ]  en,fr;q=.90
  29 [ ru en-uk en fr  ]  ru, en-UK;q=0.5, en;q=0.3, fr;q=0.1
  30 [ en-us fr es-mx  ]  en-us,fr;q=0.7,es-mx;q=0.3
  31 [ en-us en        ]  en-us, en;q=0.50
  32
  33 [ da en-gb en       ]  da, en-gb;q=0.8, en;q=0.7
  34 [ da en-gb en       ]  da, en;q=0.7, en-gb;q=0.8
  35 [ da en-gb en       ]  da, en-gb;q=0.8, en;q=0.7
  36 [ da en-gb en       ]  da,en;q=0.7,en-gb;q=0.8
  37 [ da en-gb en       ]  da, en-gb ; q=0.8, en ; q=0.7
  38 [ da en-gb en       ]  da , en-gb ; q = 0.8 , en ; q  =0.7
  39 [ da en-gb en       ]  da (yup, Danish) , en-gb ; q = 0.8 , en ; q  =0.7
  40
  41 [ no dk en-uk en-us ]  en-UK;q=0.7, en-US;q=0.6, no;q=1.0, dk;q=0.8
  42 [ no dk en-uk en-us ]  en-US;q=0.6, en-UK;q=0.7, no;q=1.0, dk;q=0.8
  43 [ no dk en-uk en-us ]  en-UK;q=0.7, no;q=1.0, en-US;q=0.6, dk;q=0.8
  44 [ no dk en-uk en-us ]  en-UK;q=0.7, no;q=1.0, dk;q=0.8, en-US;q=0.6
  45
  46 [ fi en ]  fi;q=1, en;q=0.2
  47 [ de-de de en en-us en-gb ]  de-DE, de;q=0.80, en;q=0.60, en-US;q=0.40, en-GB;q=0.20
  48 [ ru          ]  ru; q=1, *; q=0.1
  49 [ ru en       ]  ru, en; q=0.1
  50 [ ja en       ]  ja,en;q=0.5
  51 [ en          ]  en; q=1.0
  52 [ ja          ]  ja; q=1.0
  53 [ ja          ]  ja; q=1.0
  54 [ en ja       ]  en; q=0.5, ja; q=0.5
  55 [ fr-ca fr en ]  fr-ca, fr;q=0.8, en;q=0.7
  56 [ NIX ] NIX
  57 };
  58
  59 foreach my $in (@in) {
  60   $in =~ s/^\s*\[([^\]]+)\]\s*//s or die "Bad input: $in";
  61   my @should = do { my $x = $1; $x =~ m/(\S+)/g };
  62
  63   if($in eq 'NIX') { $in = ''; @should = (); }
  64
  65   local $ENV{'HTTP_ACCEPT_LANGUAGE'};
  66
  67   foreach my $modus (
  68     sub {
  69       print "# Testing with arg...\n";
  70       $ENV{'HTTP_ACCEPT_LANGUAGE'} = 'PLORK';
  71       return $_[0];
  72     },
  73     sub {
  74       print "# Testing wath HTTP_ACCEPT_LANGUAGE...\n";
  75       $ENV{'HTTP_ACCEPT_LANGUAGE'} = $_[0];
  76      return();
  77     },
  78   ) {
  79     my @args = &$modus($in);
  80
  81     # ////////////////////////////////////////////////////
  82     my @out = Locale::Maketext->_http_accept_langs(@args);
  83     # \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  84
  85     if(
  86      @out == @should
  87        and lc( join "\e", @out ) eq lc( join "\e", @should )
  88     ) {
  89       print "# Happily got [@out] from [$in]\n";
  90       ok 1;
  91     } else {
  92       ok 0;
  93       print "#Got:         [@out]\n",
  94             "# but wanted: [@should]\n",
  95             "# < \"$in\"\n#\n";
  96     }
  97   }
  98 }
  99
 100 print "#\n#\n# Bye-bye!\n";
 101 ok 1;
 102