#! --PERL--
# -*- indent-tabs-mode: nil; -*-
# vim:ft=perl:et:sw=4
# $Id$

# Sympa - SYsteme de Multi-Postage Automatique
#
# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

use lib '--modulesdir--';
use strict;
use warnings;
use English qw(-no_match_vars);
use Getopt::Long;

use Conf;
use Sympa::Constants;
use Sympa::DatabaseManager;
use Sympa::List;
use Sympa::Message;
use Sympa::Spool::Archive;

my %month_idx = qw(jan 1
    fev 2
    feb 2
    fv  2
    mar 3
    avr 4
    apr 4
    mai 5
    may 5
    jun 6
    jul 7
    aug 8
    aou 8
    sep 9
    oct 10
    nov 11
    dec 12
    dc  12);

my $msg_count = 0;

# load options ?
#$main::options{'debug'} = 1;
#$main::options{'debug2'} = 1 if ($main::options{'debug'});

$OUTPUT_AUTOFLUSH = 1;

my %opt;
unless (GetOptions(\%opt, 'input-directory=s')) {
    die("Unknown options.");
}

die
    "Usage : $ARGV[-1] [-input-directory=<directory containing individual messages>] <listname> [robot]"
    unless ($#ARGV >= 0);
my $listname = $ARGV[0];
my $robot    = $ARGV[1];

## Check UID
unless ([getpwuid $UID]->[0] eq Sympa::Constants::USER) {
    printf
        "You should run this script as user \"%s\", ignore ? (y/CR)",
        Sympa::Constants::USER;
    my $s = <STDIN>;
    die unless ($s =~ /^y$/i);
}

## Load sympa config
unless (Conf::load()) {
    die 'config_error';
}

Sympa::DatabaseManager::probe_db();

chdir $Conf::Conf{'home'};

my $list = Sympa::List->new($listname, $robot)
    or die 'Cannot create List object';

my $home_sympa;
if ($robot) {
    $home_sympa = $Conf::Conf{'home'} . '/' . $robot;
} else {
    $home_sympa = $Conf::Conf{'home'};
}
my $dest_dir = Conf::get_robot_conf($robot, 'arc_path') . '/' . $list->get_id;

unless (-d "$home_sympa/$listname") {
    die "No directory for list $listname";
}

unless (-d "$home_sympa/$listname/archives") {
    die "No archives for list $listname";
}

if (-d $dest_dir) {
    print "Web archives already exist for list $listname\nGo on (<CR>|n) ?";
    my $s = <STDIN>;
    die if ($s eq 'n');
} else {
    mkdir $dest_dir, 0755 or die;
}

if ($opt{'input-directory'}) {
    unless (-d $opt{'input-directory'}) {
        die "Parameter input-directory (%s) is not a directory",
            $opt{'input-directory'};
    }

    opendir DIR, $opt{'input-directory'} || die;
    foreach my $file (sort grep (!/^\.\.?$/, readdir(DIR))) {
        my @msgs;    #FIXME: Not used anymore.

        open ARCFILE, $opt{'input-directory'} . '/' . $file;
        my @msg = <ARCFILE>;
        push @msgs, \@msg;
        $msg_count++;
        close ARCFILE;
    }
    closedir DIR;

} else {

    print STDERR "Bursting archives\n";
    foreach my $arc_file (<$home_sympa/$listname/archives/log*>) {
        my ($first, $new);
        my $msg = [];
        my @msgs;

        ## Split the archives file
        print '.';
        open ARCFILE, $arc_file;
        while (<ARCFILE>) {
            if (/^------- THIS IS A RFC934 (COMPILANT|COMPLIANT) DIGEST/) {
                $first = 1;
                $new   = 1;
                next;
            } elsif (!$first) {
                next;
            } elsif (/^$/ && $new) {
                next;
            } elsif (/^------- CUT --- CUT/) {
                push @msgs, $msg;
                $msg_count++;
                $msg = [];
                $new = 1;
            } else {
                push @{$msg}, $_;
                undef $new;
            }
        }
        close ARCFILE;

        ##Dump
        #foreach my $i (0..$#msgs) {
        #    printf "******** Message %d *******\n", $i;
        #    print @{$msgs[$i]};
        #}

        ## Store messages in web arc
        store_messages(\@msgs, $dest_dir);

    }
}

print STDERR "\nFound $msg_count messages\n";

# Rebuild web archives
print STDERR "Rebuilding HTML\n";
my $arc_message = Sympa::Message->new(
    sprintf("\nrebuildarc %s *\n\n", $list->{'name'}),
    context => $list->{'domain'},
    sender  => sprintf('listmaster@%s', $list->{'domain'}),
    date    => time
);
Sympa::Spool::Archive->new->store($arc_message);

print STDERR "\nHave a look in $dest_dir/-/ directory for messages dateless
Now, you should add a web_archive parameter in the config file to make it accessible from the web\n";

## Analyze message header fields and store them in web archives
sub store_messages {
    my ($list_of_msg, $dest_dir) = @_;
    my @msgs = @{$list_of_msg};

    my %nummsg;

    ## Analyzing Date header fields
    #print STDERR "Analysing Date: header fields\n";
    foreach my $msg (@msgs) {
        my $incorrect = 0;
        my ($date, $year, $month);

        print '.';
        foreach (@{$msg}) {
            if (/^Date:\s+(.*)$/) {
                #print STDERR "#$_#\n";
                $date = $1;

                # Date type : Mon, 8 Dec 97 13:33:47 +0100
                if ($date =~
                    /^\w{2,3},\s+\d{1,2}\s+([\w\x80-\xFF]{2,3})\s+(\d{2,4})/)
                {
                    $month = $1;
                    $year  = $2;
                    #print STDERR "$month/$year\n";

                    # Date type : 8 Dec 97 13:33:47+0100
                } elsif ($date =~ /^\d{1,2}\s+(\w{3}) (\d{2,4})/) {
                    $month = $1;
                    $year  = $2;

                    # Date type : 8-DEC-1997 13:33:47 +0100
                } elsif ($date =~ /^\d{1,2}-(\w{3})-(\d{4})/) {
                    $month = $1;
                    $year  = $2;

                    # Date type : Mon Dec 8 13:33:47 1997
                } elsif ($date =~
                    /^\w+\s+(\w+)\s+\d{1,2} \d+:\d+:\d+ (GMT )?(\d{4})/) {
                    $month = $1;
                    $year  = $3;

                    # unknown date format
                } else {
                    $incorrect = 1;
                    last;
                }

                # Month format
                if ($month !~ /^\d+$/) {
                    $month =~ y/\xe9\xfb/eu/;    #FIXME
                    $month =~ y/A-Z/a-z/;
                    if (!$month_idx{$month}) {
                        $incorrect = 1;
                    } else {
                        $month = $month_idx{$month};
                    }
                } elsif (($month < 1) or ($month > 12)) {
                    $incorrect = 1;
                }
                $month = "0" . $month if $month =~ /^\d$/;

                # Checking Year format
                if ($year =~ /^[89]\d$/) {
                    $year = "19" . $year;
                } elsif ($year !~ /^19[89]\d|20[0-9][0-9]$/) {
                    $incorrect = 1;
                }

                last;
            }

            # empty line => end of header
            if (/^\s*$/) {
                last;
            }
        }

        # Unknown date format/No date
        if ($incorrect || !$month || !$year) {
            $year  = 'UN';
            $month = 'KNOWN';
        }

        # New month
        if (!-d "$dest_dir/$year-$month") {
            print "\nNew directory $year-$month\n";
            `mkdir $dest_dir/$year-$month`;
        }

        if (!-d "$dest_dir/$year-$month/arctxt") {
            `mkdir $dest_dir/$year-$month/arctxt`;
        }

        $nummsg{$year}{$month}++
            while (-e "$dest_dir/$year-$month/arctxt/$nummsg{$year}{$month}");

        # Save message
        open DESTFILE,
            ">$dest_dir/$year-$month/arctxt/$nummsg{$year}{$month}";
        print DESTFILE @{$msg};
        close DESTFILE;
        #    `mv $m $dest_dir/$year-$month/arctxt/$nummsg{$year}{$month}`;
        $nummsg{$year}{$month}++;
    }

    return 1;
}