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');
      $client_connection->send_file("../$path_info");
    } 
    elsif ($path_info =~ /^.*\.(gif|png|jpg|jpeg)$/) {
      print STDERR "IMAGE $path_info\n";
      $client_connection->send_file_response("../$path_info");
    }
    else {
      $client_connection->send_file_response("../../$path_info");
    } 
  }
  $client_connection->close;
  undef($client_connection);
}

__DATA__
AD	Andorra
AE	United Arab Emirates
AF	Afghanistan
AG	Antigua & Barbuda
AI	Anguilla
AL	Albania
AM	Armenia
AN	Netherlands Antilles
AO	Angola
AQ	Antarctica
AR	Argentina
AS	American Samoa
AT	Austria
AU	Australia
AW	Aruba
AZ	Azerbaijan
BA	Bosnia and Herzegovina
BB	Barbados
BD	Bangladesh
BE	Belgium
BF	Burkina Faso
BG	Bulgaria
BH	Bahrain
BI	Burundi
BJ	Benin
BM	Bermuda
BN	Brunei Darussalam
BO	Bolivia
BR	Brazil
BS	Bahama
BT	Bhutan
BU	Burma (no longer exists)
BV	Bouvet Island
BW	Botswana
BY	Belarus
BZ	Belize