package Marica::Base::HeaderParser::modeles ;
#prend les paramètres de la requête dans le query_string, les place dans la requête associée au modèle demandé
#et écrit le document dans /home/www_marica/base/listing/$id_session


use strict ;

use warnings ;

use Apache2::Const -compile => qw( OK SERVER_ERROR DECLINED REDIRECT) ;

sub handler  {

    my $r = shift ;

    my $path = $r->filename ;

    #ne traiter que les modèles
    return Apache2::Const::DECLINED if ( $path !~ /modeles/ ) ;

    $r->no_cache(1) ;

    #pour la récupération des paramètres passés dans le query_string
    my $req = Apache2::Request->new($r) ;

    my ( $content, $sql, $sth ) ;

    my $dbh = $r->pnotes('dbh') ;

    local $@ ;

    my $id_client = $r->pnotes('session')->{id_client} ;

    #Recherche des paramètres de la requête associée au modèle dans le query string de la requête
    #exemple de requête : http://marica.fr/base/modeles/1/3/11.doc?id_contentieux=5275&id_tiers=5774
    my @path = split /\//, $path ;

    #enlever l'extension du fichier pour avoir id_modele
    ( my $id_modele = pop @path ) =~ s/\..*// ;

    #recherche du sql de la requête associée au modèle et du type de document (.docx, .odt)
    $sql = 'SELECT sql_string, extension, id_categorie FROM tblmodele_document WHERE id_modele = ?' ;

    my $ary_ref = $dbh->selectall_arrayref( $sql, { }, ( $id_modele ) ) ;

    $sql = $ary_ref->[0]->[0] ;

    my $extension =  $ary_ref->[0]->[1] ;

    my $id_categorie = $ary_ref->[0]->[2] ;

    #id_contentieux est toujours présent
    my $id_contentieux = $req->param('id_contentieux') ;

    #le remplacer dans le sql de la requête
    $sql =~ s/ID_CONTENTIEUX/$id_contentieux/ ;

    #paramètres optionnels
    my ($id_tiers, $intervenant) ;

    #la dernière entrée de @path contient le type de modèle (1:Dossier/2:Intervenant/3:Tiers)
    my $type = pop @path ;

    if ( $type == 2 ) {

    $intervenant = $req->param('intervenant') ;

    $sql =~ s/INTERVENANT/$intervenant/ ;


    } elsif ( $type == 3 ) {

    $id_tiers = $req->param('id_tiers') ;

    $sql =~ s/ID_TIERS/$id_tiers/ ;

    }


    #rechercher les données et écrire le fichier 'data.extension' qui sera récupéré
    my @data_set = @ { $dbh->selectall_arrayref( $sql, { Slice => { } }, ( ) ) } ;

    #$data donne les valeurs à remplacer dans le template
    my $data = eval { $data_set[0] } ;

    #construction du chemin vers le fichier rendu
    my $base_file_name = $r->pnotes('session')->{_session_id} ;

    #créer un répertoire avec le nom de la session dans /base/listing; il contiendra les fichiers de l'archive (.docx ou .odt) dézippée
    my $recipient_dir = $r->document_root . '/base/listing/' . $base_file_name ;

    my @args = ('mkdir', '-p', $recipient_dir ) ;

    #path is always tainted when Perl starts; make -T switch happy
    $ENV{'PATH'} = '/bin:/usr/bin' ;

    eval {

    system(@args) == 0 or die "system @args failed: $?" ;

    } ;

    #le modèle de base (/home/www_marica/base/modeles/1/2/23.docx)
    my $template = $r->document_root . '/base/modeles/' . $r->pnotes('session')->{id_client} . '/' . $id_categorie . '/' . $id_modele . '.' . $extension ;

    my $output_file = $base_file_name . '.' . $extension ;

    #création du répertoire de décompression du template
    #-o overwrite files -q quiet
    #on extrait le contenu du template
    my $command = "unzip -o -q $template -d $recipient_dir" ;

    system( $command ) == 0 or die "can't unzip $template : $!\n" ;

    #slurp mode on; apache limite les uploads à 64MB dans la configuration standard
    local $/ = undef ;

    #partie à modifier : dans un fichier docx, le texte se trouve dans word/document.xml
    my $document_content = $recipient_dir . '/word/document.xml' ;

    open DOCUMENT_CONTENT, "<", "$document_content" or die "can't open $document_content : $!\n" ;

    #on slurpe le contenu
    my $xml = <DOCUMENT_CONTENT> ;

    close DOCUMENT_CONTENT ;

    #remplacement des data_field par leur valeur
    for ( keys %{ $data } ) {

    #éviter l'erreur uninitialized value si le champ est vide
    $data->{$_} ||= '' ;

    $xml =~ s/$_/$data->{$_}/g ;

    }

    #réecrire le contenu du document avec les nouvelles valeurs
    open DOCUMENT_CONTENT, ">", "$document_content" or die "can't open $document_content : $!\n" ;

    print DOCUMENT_CONTENT $xml ;

    close DOCUMENT_CONTENT ;

    #il faut préfixer le nom du fichier produit avec _session_id pour passer le barrage de HeaderParser/modeles.pm
    my $destination_file = $r->pnotes('session')->{_session_id} . '.' . $extension  ;

    chdir $recipient_dir ;

    #zipper le nouveau contenu; q = quiet r = recursive
    $command = 'zip -qr ' . $r->document_root() . '/base/listing/' . $destination_file . ' *' ;

    system( $command ) == 0 or die "can't zip $base_file_name.docx: $!\n" ;

    #emplacement du fichier renvoyé après substitution des valeurs
    my $location = '/base/listing/' . $destination_file ;

    $r->headers_out->set(Location => $location) ;

    return Apache2::Const::REDIRECT ;

}


1 ;