#!/usr/bin/perl -w
# -*- coding:utf-8 -*-

# Simple tracking link, prints to files

use CGI; # qw(-no_debug :standard);
# comment to test locally:
use CGI::Carp qw(fatalsToBrowser);
# Use of the encoding pragma is deprecated at /webvol/web/comparable/bucc2017/cgi-bin/download-sample.cgi line 9.
# use encoding 'utf8';
use utf8;			# use unicode expression in this script
use strict;

# man CGI: (Avoiding Denial of Service Attacks)
$CGI::POST_MAX=1024 * 10;  # max 10K posts
$CGI::DISABLE_UPLOADS = 1;  # no uploads

our $Main_Page_Url = "bucc2017-task.html";

#================================================================
# Message page
#================================================================

# Error message, stop the program
sub error_page {
    my($q, $message) = @_;
    print join('',
	       $q->header(-charset => "utf-8"),
	       $q->start_html(-title=>"Internal error of link generation program",
			      # -author=>"$Auteur",
			      -target=>'ProcessingError',
			      -BGCOLOR=>'#ffdfdf',
			      -lang => "en-US",), "\n",
	       $q->h1("Internal error of link generation program"), "\n",
	       $q->hr(), "\n",
	       $q->em("$message"), "\n",
	       $q->hr(), "\n",
	       $q->end_html) . "\n";
    exit;
}

# Returns a date of the form AAAA/MM/DD
sub DateTime {
    my($time) = @_;
    $time = time unless defined $time;
    my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
        = localtime($time);
    $mon++;                     # month from 0
    $year += 1900;              # year on 4 digits
    # to quiet WarnIfDebuging :-)
    my(@ignore) = ($mday,$mon,$year,$wday,$yday,$isdst);
    @ignore = @ignore;          # removes warning :-/
    return sprintf("%0.4i/%0.2i/%0.2i %0.2i:%0.2i:%0.2i", $year, $mon, $mday, $hour, $min, $sec);
}

#================================================================
package AbsoluteDir;
#================================================================

# use Mouse;

# has "base_dir" => (is => 'rw', isa => 'Str', default => "https://comparable.limsi.fr/bucc2017", );
our $base_dir = "https://comparable.limsi.fr/bucc2017";

sub full_path {
#    my($self, $filename) = @_;
    my($filename) = @_;
#    join("/", $self->base_dir, $filename);
    join("/", $base_dir, $filename);
}

# __PACKAGE__->meta->make_immutable;

#================================================================
package Recorder;
#================================================================

# use Mouse;

# has "tracking_dir" => (is => 'rw', isa => 'Str', default => "/webvol/users/pz/bucc2017/registration", );
# has "file_pattern" => (is => 'rw', isa => 'Str', default => "%0.3i", );
# has "file_extension" => (is => 'rw', isa => 'Str', default => ".tab", );
# has "max_file_version" => (is => 'rw', isa => 'Int', default => 1000, );
# has "cgi" => (is => 'rw', isa => 'CGI', );
# has "filename" => (is => 'rw', isa => 'Str', default => sub { ""; }, );
# our "file_id" => (is => 'rw', isa => 'Str', default => sub { ""; }, );
our %defaults = (
    tracking_dir => "/webvol/users/pz/bucc2017/registration",
    file_pattern => "%0.3i",
    file_extension => ".tab",
    max_file_version => 1000,
    cgi => "",
    file_id => "",
    );

sub tracking_dir {my $self = shift; if (@_ == 1) {$self->{"tracking_dir"} = $_[0];} else {$self->{"tracking_dir"};}}
sub file_pattern {my $self = shift; if (@_ == 1) {$self->{"file_pattern"} = $_[0];} else {$self->{"file_pattern"};}}
sub file_extension {my $self = shift; if (@_ == 1) {$self->{"file_extension"} = $_[0];} else {$self->{"file_extension"};}}
sub max_file_version {my $self = shift; if (@_ == 1) {$self->{"max_file_version"} = $_[0];} else {$self->{"max_file_version"};}}
sub cgi {my $self = shift; if (@_ == 1) {$self->{"cgi"} = $_[0];} else {$self->{"cgi"};}}
sub filename {my $self = shift; if (@_ == 1) {$self->{"filename"} = $_[0];} else {$self->{"filename"};}}
sub file_id {my $self = shift; if (@_ == 1) {$self->{"file_id"} = $_[0];} else {$self->{"file_id"};}}

# sub BUILD {
#     my($self) = @_;

#     $self;
# }

sub new {
    my $class = shift;
    my %params = @_;
    my %self = (%defaults, %params);
    my $self = \%self;
    bless $self, $class;
    # $self->initialize();
    return $self;
}

sub record {
    my($self, $record_name, $record_contents) = @_;
    $self->set_file_name_for_record($record_name);
    # warn "process_answer: writing filename '$filename'\n";
    $self->write_record_file($record_contents);
    return $self->file_id; # part of the filename that we agree to display to a user (no directory, no extension)
}

# File naming: computes a value for record's filename and stores it into $self->filename
sub set_file_name_for_record {
    my($self, $record_name) = @_;
    # warn "record_name='$record_name'\n";
    # end of name, must contain only letter characters
    $record_name =~ s{\W}{_}g;
    # warn "cleaned record_name='$record_name'\n";
    my $path_pattern = join("/", $self->tracking_dir, join("-", $record_name, $self->file_pattern));
    # warn "path_pattern='$path_pattern'\n";
    for (my $number=1; $number <$self->max_file_version; $number++) {
	my $file = sprintf($path_pattern . $self->file_extension, $number);
	# warn "% File for record: '$file'\n";
	if (! -f $file) {
	    $self->filename($file);
	    last;
	}
    }
    unless ($self->filename) {
	$self->filename(sprintf($path_pattern, $self->max_file_version + 1)); # if overflow, overwrite max number (do not overwrite earlier records)
    }
    $self->file_id((split(/\//, $self->filename))[-1]);
}

# File creation
sub write_record_file {
    my($self, $content) = @_;

    # my $filename = full_path($relative_name, $Tracking_Dir);
    my $filename = $self->filename;
    open(FILE, ">:utf8", $filename) ||
	main::error_page($self->cgi, "Could not write registration file '$filename' ($!)\n");
    print FILE $content;
    print FILE "\n"		# ajoute un \n final si absent
	unless $content =~ /\n$/;
    close FILE ||
	main::error_page($self->cgi, "Could not close registration file '$filename' ($!)\n");
}


# __PACKAGE__->meta->make_immutable;

#================================================================
package PageModel;
#================================================================

# use Mouse;

sub cgi {my $self = shift; if (@_ == 1) {$self->{"cgi"} = $_[0];} else {$self->{"cgi"}};}
# has "cgi" => (is => 'rw', isa => 'CGI', );

sub new {
    my $class = shift;
    my %params = @_;
    my %self = (%defaults, %params);
    my $self = \%self;
    bless $self, $class;
    # $self->initialize();
    return $self;
}

# sub BUILD {
#     my($self) = @_;

#     $self;
# }

# standard tempate for this application
sub create_page {
    my ($self, $titre, $auteur, $MetaMotscles, $MetaContenu, $couleur,
	@contenu) = @_;

    my $q = $self->cgi;
    return join('',
		$q->header( -charset => "utf-8", -content_type => 'text/html'),
		$q->start_html(-title=>"$titre",
			       -author=>"$auteur",
#			 -base=>'true',
#			 -target=>'_blank',
			       -meta=>{'keywords'=>"$MetaMotscles",
				       'copyright'=>'copyright (c) 2017 PZ'},
#			 -style=>{'src'=>'/styles/style1.css'},
			       -BGCOLOR=>"$couleur"), "\n",

		$q->h1($titre), "\n",
		$q->hr(), "\n",
		@contenu, "\n",
		$q->end_html) . "\n";
}

# __PACKAGE__->meta->make_immutable;

#================================================================
package main;
#================================================================

#================================================================
# Content pages
#================================================================

our $Download_Dir = "..";
our $Dataset_Pattern = "bucc2017-%s.%s-gold.tar.bz2";

sub dataset_row {
    my($q, $lp, $split) = @_;
    my $relative_url = sprintf($Dataset_Pattern, $lp, $split);
    my $full_url = join("/", $Download_Dir, $relative_url);
    $q->TR($q->td($q->em($lp)), $q->td($q->a({href=>$full_url}, $relative_url)));
}

sub download_page_contents {
    my($q, $header, $footer, $langs) = @_;
    my @rows = ();
    for my $split (qw(sample)) {
	push @rows, $q->TR
	    ($q->th({-colspan=>2}, "Sample datasets"));
	push @rows, $q->TR
	    ($q->th("Language pair"), $q->th("Dataset"));
	# for my $lp (qw(de-en fr-en ru-en zh-en)) {
	for my $lp (@$langs) {
	    push @rows, dataset_row($q, $lp, $split);
	}
    }
    join("\n",
	 $header,
	 $q->div({-style=>"margin-left: 1cm;"}, $q->table(join("\n", @rows),),),
	 $footer,
	);
}


#================================================================
# Collect form contents and execute action
#================================================================

sub process_query {
    my($q, $langs) = @_;
    # print $q->Dump;
    my @information =
	map { my $str = $q->$_(); if (defined($str)) { $str =~ s/\s+//; $str =~ s/\s+$//; $str; } else {""}; } qw(referer remote_addr remote_host https);
    my $record_contents = join("\t", @$langs, @information, DateTime());
    my $ip_addr = $q->remote_addr;
    my $file_id = Recorder->new(cgi=>$q,
				# uncomment to test locally:
				# tracking_dir=>"/tmp/track-test"
	)->record(
	$ip_addr,
	$record_contents, "\n");
    return ($file_id, $record_contents);
}

#================================================================
# Lecture de la requête reçue et calcul de la réponse
#================================================================

sub my_cgi_handler {
    my $q = new CGI;
    my @langs = ();
    if (exists($q->Vars->{'langs'})) {
	@langs = split(/,/, $q->Vars->{'langs'}); # parameter 'langs' should contain a comma-separated list of language pairs
    }
    my ($record_name, $record_contents) = process_query($q, \@langs);
    PageModel->new("cgi" => $q)->create_page(
	"BUCC 2017 Shared Task sample dataset download",
	'pz@limsi.fr',
	"BUCC, 2017, Datasets, Sample",
	"BUCC 2017 Shared Task sample dataset download",
	'#8F8FFF',
	# start of contents:
	download_page_contents($q,
			       "",
			       $q->p({-style=>"font-size: xx-small;"}, sprintf("Download links for %s (%s)", $record_contents, $record_name)),
			       \@langs), "\n",
	$q->hr(), "\n",
	$q->p({-style=>"text-align: right;"}, $q->a({-href=>AbsoluteDir::full_path($Main_Page_Url)}, "BUCC 2017 Shared Task main page")), "\n",
	);
}

#================================================================
# Calcul et impression de la réponse à la requête reçue
#================================================================

print my_cgi_handler();