view release on metacpan or  search on metacpan

test/functional/examples.pl  view on Meta::CPAN

use strict;
use warnings;

use CGI;
use HTTP::Daemon;
use HTTP::Status;
use URI::Escape;
use JSON;
use Encode qw/decode_utf8/;

my $query;
my @countries = <DATA>;
chomp foreach @countries;

my $port = $ARGV[0] || 8085;

my $consonnes = qr/[bcdfghjklmnpqrstvwxyz]/;

my $daemon = HTTP::Daemon->new(LocalPort => $port) || die;
print "Please contact me at: <URL:", $daemon->url, ">\n";
while (my $client_connection = $daemon->accept) {
  while (my $req = $client_connection->get_request) {
    my $path_info = decode_utf8(substr(uri_unescape($req->url->path), 1));

    print STDERR "REQUEST: $path_info\n";

    $client_connection->force_last_request;

    if ($path_info =~ s[^ac/country/][]) {
      my @countries_list = grep /^$path_info|.*\t$path_info/i, @countries;
      my @choices = map { my ($c, $l) = split /\t/, $_;
                          {value => $l,
                           label => '<tt>['.$c.']</tt>  '.$l,
                           code  => $c, } } @countries_list;

      my $json = to_json(\@choices, {ascii => 1});
      print STDERR "RESPONSE: $json\n";
      
      my $response = HTTP::Response->new(RC_OK);
      $response->header(
        'Content-Type'  => 'text/javascript; charset=ISO-8859-1',
        'Cache-Control' => 'no-cache, must-revalidate, max-age=0',
        'Pragma'        => 'no-cache',
        'Expires'       => '0');
      $response->content($json);
      $client_connection->send_response($response);
    }
    elsif ($path_info =~ s[^g/country/][]) {
      $query = new CGI($req->content);
      
      my $db_index = $query->param('INDEX') ? $query->param('INDEX') - 1 : 0;
      my $step     = $query->param('STEP') || 11;

      my @countries_list = grep /^$path_info|.*\t$path_info/i, @countries;
      my @choices = map {  my ($c, $l) = split /\t/, $_;
                          {value => $l, 
                           code  => $c } } @countries_list;

      my $total       = scalar @choices;
      my $start_index = $db_index;
      my $end_index   = $db_index + $step;
      my @tranche     = splice @choices, $start_index, $step;

      my $resp = {
        liste => \@tranche,
        total => $total,
      };

      my $json = to_json($resp, {ascii => 1});
      
      my $response = HTTP::Response->new(RC_OK);
      $response->header(
        'Content-Type'  => 'application/json; charset=ISO-8859-1',
        'Cache-Control' => 'no-cache, must-revalidate, max-age=0',
        'Pragma'        => 'no-cache',
        'Expires'       => '0');
      $response->content( $json );
      $client_connection->send_response($response);
    }
    elsif ($path_info =~ /^.*\.css$/) {
      print STDERR "CSS $path_info\n";
      my $response = HTTP::Response->new(RC_OK);
      $response->header('Content-Type'  => 'text/css; charset=utf-8');