<commit_before>package Server;

use strict;
use warnings;

use HTTP::Server::Simple::CGI;
use base qw(HTTP::Server::Simple::CGI);

use Data::Dumper;

use Resource;
use YAML::Tiny;

my %resource_by;
my $cgi;



sub new {
    my $class = shift;

    my $server = $class->SUPER::new(@_);

    bless $server, $class;
}



sub _reply {
    my ($status, $type, @output) = @_;

    $type = 'text/plain'
        unless defined $type and $type ne '';

    print "HTTP/1.0 $status\n", $cgi->header('-type' => $type), @output, "\n";
}



sub _fail {
    my ($code, $message) = @_;

    my %codes = (
	400 => 'Bad Request',
	403 => 'Forbidden',
	404 => 'Not Found',
        405 => 'Method Not Allowed',
    );

    my $text = $codes{$code} || die "Unknown http code error";
    _reply($code . $text, 'text/plain', $message || $text)
}
       

    


sub _reply_default {
    _fail(404);
}


sub _list_resources {
    my $yaml = YAML::Tiny->new();
    $yaml->[0] = \%resource_by;

    _reply('200 OK', 'text/yaml', $yaml->write_string());
}

sub _create_resource {
    my ($id) = @_;

    $id = $cgi->param('id')
        unless defined $id;
    my $desc = $cgi->param('desc');
    my $gra  = $cgi->param('gra');

    if (defined $id && exists $resource_by{$id}) {
        _fail(403, "Resource #$id already exists!");
    }
    elsif (!defined $id && !defined $desc && !defined $gra) {
        my $resource = Resource->from_xml($cgi->param('POSTDATA'));
        $resource_by{ $resource->{id} } = $resource;
        _reply('201 Created', 'text/plain', "Resource #$resource->{id} created");
    }
    elsif (defined $id && defined $desc && defined $gra) {
        my $resource = Resource->new($id, $desc, $gra);
        $resource_by{ $resource->{id} } = $resource;
        _reply('201 Created', 'text/plain', "Resource #$id created");
    }
    else {
        _fail(400, 'Missing description!');
    }
}

sub _retrieve_resource {
    my ($id) = @_;

    if (!defined $id || !exists $resource_by{$id}) {
        _fail(404);
    }
    else {
        _reply('200 OK', 'text/xml', $resource_by{$id}->to_xml());
    }
}

sub _update_resource {
    _reply_default();
}

sub _delete_resource {
    my ($id) = @_;

    if (!defined $id || !exists $resource_by{$id}) {
        _fail(404);
    }
    else {
        delete $resource_by{$id};
        _reply('200 OK', 'text/plain', "Resource #$id deleted");
    }
}



#
# Despatxa segons URL i operació contra aquest
# controlador. La URL és un pattern amb blocs nominals
# que són automàticament passats a la funció.
#
# Nota: hauria de funcionar amb "named buffers" però només
# s'implementen a partir de perl 5.10. Quina misèria, no?
# A Python fa temps que funcionen...
#
my %crud_for = (
    '/resources' => {
         GET    => \&_list_resources,
    },
    '/resource/(\d+)' => {
	 POST   => \&_create_resource,
         GET    => \&_retrieve_resource,
         PUT    => \&_update_resource,
         DELETE => \&_delete_resource,
    },
    '/resource/(\d+)/bookings' => {
         GET    => \&_reply_default,
         POST   => \&_reply_default,
    },
    '/booking/(\d+)' => {
         GET    => \&_reply_default,
         PUT    => \&_reply_default,
         DELETE => \&_reply_default,
    },
    'default_action' => {
         POST   => \&_reply_default,
         GET    => \&_reply_default,
         PUT    => \&_reply_default,
         DELETE => \&_reply_default,
    },
);


#
# Aquest és el handler que invoca el ServerHTTP per a cada
# request que ha de resoldre. El handler ha de trencar la URL del
# request i determinar qui ha de donar el servei.
#
sub handle_request {
    my $self = shift;

    # Obté les dades del request via CGI
    $cgi  = shift;
    my $path_info = $cgi->path_info();
    my $method    = $cgi->request_method();

    # Busca el primer pattern del diccionari que s'acara.
    my $url_key = 'default_action';
    foreach my $url_pattern (keys(%crud_for)) {
	my $pattern = '^' . $url_pattern . '/?$'; # allow URLs ending in '/'
	if ($path_info =~ m{$pattern}) {
	    $url_key = $url_pattern;
	    last;
	}
    }

    # Despatxa segons recurs i mètode invocat
    if (exists $crud_for{$url_key}->{$method}) {
	$crud_for{$url_key}->{$method}->($1);
    } else {
	# Requested http method not available
	_fail(405);
    }
}


1;<commit_msg>Modificat substancialment:  - Reordenat el mòdul per fer més clares les diferents parts  - Eliminades les variables globals (cgi i ...)  - Eliminat el codi que no feia la feina i substituït per placeholders<commit_after>package Server;

use strict;
use warnings;

use HTTP::Server::Simple::CGI;
use base qw(HTTP::Server::Simple::CGI);
use CGI qw(header);

use Resource;


# Nota: hauria de funcionar amb "named groups" però només
# s'implementen a partir de perl 5.10. Quina misèria, no?
# A Python fa temps que funcionen...
#
# Dispatcher table. Associates a handler to an URL. Groups in
# the URL pattern are given as parameters to handler.
my %crud_for = (
    '/resources' => {
         GET    => \&_list_resources,
	 POST   => \&_create_resource,
    },
    '/resource/(\d+)' => {
         DELETE => \&_delete_resource,
    },
    '/resource/(\d+)/bookings' => {
    },
    '/booking/(\d+)' => {
    },
);


# Http request dispatcher. Sends every request to the corresponding
# handler according to hash %crud_for. The handler receives
# the CGI object and the list of parameters acording to the corresponding
# groups in the %crud_for regular expressions.
sub handle_request {
    my $self = shift;
    my ($cgi) = @_;

    my $path_info = $cgi->path_info();
    my $method    = $cgi->request_method();

    # Find the corresponding action
    my $url_key = 'default_action';
    foreach my $url_pattern (keys(%crud_for)) {
	# Anchor pattern and allow URLs ending in '/'
	my $pattern = '^' . $url_pattern . '/?$'; 
	if ($path_info =~ m{$pattern}) {
	    $url_key = $url_pattern;
	    last;
	}
    }

    # Dispatch to the corresponding action. 
    # Pass parameters obtained from the pattern to action
    if (exists $crud_for{$url_key}) {
	if (exists $crud_for{$url_key}->{$method}) {
	    $crud_for{$url_key}->{$method}->($cgi, $1);
	} else {
	    # Requested http method not available
	    _status(405);
	}
    } else {
	# Requested URL not available
	_status(404)
    }
}



#############################################################
# Http tools
#############################################################

sub _reply {
    my ($status, $type, @output) = @_;

    $type = 'text/plain' unless defined $type and $type ne '';
    print "HTTP/1.0 $status\n", header($type), @output, "\n";
}


# Prints an Http response. Message is optional. 
sub _status {
    my ($code, $message) = @_;

    my %codes = (
        200 => 'OK',
        201 => 'Created',
	400 => 'Bad Request',
	403 => 'Forbidden',
	404 => 'Not Found',
        405 => 'Method Not Allowed',
    );

    my $text = $codes{$code} || die "Unknown http code error";
    _reply($code . $text, 'text/plain', $message || $text)
}
       

sub _send_xml {
    my $xml = shift;

    _reply('200 OK', 'text/xml', $xml);
}





##############################################################
# Handlers for resources
##############################################################

sub _list_resources {
    _status(200, "List of resources");
}

sub _create_resource {
    my ($cgi, $id) = @_;

    if ($id == 1) {
        _status(403, "Resource #$id already exists!");
    } else {
        _status(201, "Resource #$id created");
    }
}

sub _retrieve_resource {
    my (undef, $id) = @_;
    
    _status(200, "Resource #$id retrieved");
    
}


sub _delete_resource {
    my (undef, $id) = @_;

    _reply('200 OK', 'text/plain', "Resource #$id deleted");
}


1;
{'fraction_non_alphanumeric': 0.18815466183887236, 'fraction_numerical': 0.013319539635329109, 'mean_word_length': 2.796759941089838, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 65, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 7}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1491205', 'n_tokens_mistral': 2768, 'n_tokens_neox': 2609, 'n_words': 716}