#!/usr/bin/perl

# Hassle-free list migration from Majordomo 1.94.5 to Sympa 6.0
# 2009 by Matthias Warkus <warkusm@hrz.uni-marburg.de>
# Applications Department, Computing Centre, Marburg University


use strict;
use File::Temp qw/ tempfile /;
use File::Path;
use Mail::Address;

######################################################################
# Source side: Majordomo-related constants and stuff
#####################################################################

require "config_parse.pl";

# two-digit years less or equal to this are considered to be in the
# 21st century, others in the 20th
my $Y2KLINE = 95;
my $MJPREFIX = "/majordomo-import";
my $ALIASESFILENAME = "/majordomo-import/aliases";
my $LISTDIR = $MJPREFIX . "/lists";
my $ARCHIVEDIR = $MJPREFIX . "/archive";
#my $DOCDIR = $MJPREFIX . "/doc"; # not needed at present

######################################################################
# Target side: Sympa-related constants
######################################################################

my $LANGUAGE = "de";
my $initial_status = "pending"; # TODO command line switch?
my $topics = "service"; # TODO fetch from command line?
my $web_archive_access = "private"; #TODO enable choice?
my $SYMPAPREFIX = "/home/sympa";
my $SYMPA = $SYMPAPREFIX . "/sbin/sympa.pl";
my $ROBOT = "lists.uni-marburg.de";
my $DATATARGETDIR = "/var/spool/sympa/list_data";
my $ARCHIVETARGETDIR = "/archive";

# set to 1 to actually make Sympa calls
my $thisisnotadrill = 1;

#######################################################################
# Get started
#######################################################################

my $argc = @ARGV;
$argc == 1
  or die "$0 needs exactly one argument, the list name.\n";
my $listname = $ARGV[0];

# TODO fetch from command line or determine heuristically
my $listtype = "newsletter";

get_config($LISTDIR, $listname);
# Ignore errors! We know what we are doing, or, at least, so we pretend
#&& die "Could not get configuration for $listname from $LISTDIR: $!";

#my $key;
#foreach $key (keys %main::config_opts)
#  {
#    print $key . " = " . $main::config_opts{$key} . "\n";
#  }
#die;

#########################################################################
# create XML template for list creation, call sympa --create_list with it
#########################################################################

(my $xmlfile, my $xmlfilename) = tempfile(UNLINK => 1, SUFFIX => ".xml");

print $xmlfile "<?xml version=\"1.0\" ?>\n";
print $xmlfile "<list>\n";
print $xmlfile "<listname>" . $listname . "</listname>\n";
print $xmlfile "<type>" . $listtype . "</type>\n";
print $xmlfile "<subject>" . $main::config_opts{$listname, "description"} . "</subject>\n";

my $infofilename = $LISTDIR . "/" . $listname . ".info";
if (-e $infofilename)
  {
    print $xmlfile "<description>";
    open INFOFILE, "<", $infofilename
      or die "$infofilename exists, yet can't be opened: $!";
    while (my $line = <INFOFILE>)
      {
        print $xmlfile $line;
      }
    close INFOFILE;
    print $xmlfile "</description>\n";
  };


# reduce subscribe policies to two cases
my $policyin = $main::config_opts{$listname, "subscribe_policy"};
my $policy;
if (($policyin =~ /auto/) || ($policyin =~ /open/))
  {
    $policy = "auth_notify";
  }
else
  {
    $policy = "auth_owner";
  }
print $xmlfile "<subscribe>" . $policy . "</subscribe>\n";

# default to listmaster ownership
my $owner = 'listmaster@lists.uni-marburg.de';

open ALIASESFILE, "<", $ALIASESFILENAME
  or die "Can't open $ALIASESFILENAME: $!";
while (my $line = <ALIASESFILE>)
  {
    my $pattern = $listname . "-owner:";
    if ($line =~ /$pattern/)
      {
        my @fields = split(/: /, $line);
	$owner = @fields[1];
      }
  }
close ALIASESFILE;

print $xmlfile "<owner multiple=\"1\">\n";
print $xmlfile "  <email>" . $owner . "</email>\n";
print $xmlfile "</owner>\n";

if ("" ne main::cf_ck_bool($listname, "moderator"))
  {
    my @moderators = split(/,/, $main::config_opts{$listname, "moderator"});
    my $moderator;
    foreach $moderator (@moderators)
      {
        print $xmlfile "<moderator multiple=\"1\">\n";
	print $xmlfile "  <email>" . $moderator . "</email>\n";
	print $xmlfile "</moderator>\n";
      }
   }

print $xmlfile "<status>" . $initial_status . "</status>\n";
print $xmlfile "<language>" . $LANGUAGE . "</language>\n";
print $xmlfile "<topic>" . $topics . "</topic>\n";
print $xmlfile "<web_archive>\n";
print $xmlfile "  <access>" . $web_archive_access . "</access>\n";
print $xmlfile "</web_archive>\n";
print $xmlfile "</list>\n";


print "Created XML list template file " . $xmlfilename . "\n";
#system("cat $xmlfilename"); die;

my $cmdline =
  $SYMPA . " --create_list --robot " . $ROBOT . " --input_file ". $xmlfilename;

if ($thisisnotadrill)
  {
    system("$cmdline");
#      Ignore errors! -- here we just pretend
#      or die "Could not call Sympa to create list: $!";
  }
else
  {
    print "Would normally now call $cmdline\n";
  }

#############################################################################
# Grab headers and footers, put them into appropriate template files
#############################################################################

if ($main::config_opts{$listname, "message_header"} ne '')
  {
    my $header = $main::config_opts{$listname, "message_header"};
    $header =~ s/\001|$/\n/g;
    my $headerfilename = $DATATARGETDIR . "/" . $ROBOT . "/" . $listname . "/message.header";
    open headerfile, ">", $headerfilename
      or die "Could not open header file $headerfilename: $!";
    print headerfile $header;
    close headerfile;
    print "Wrote header file\n";
 }
else
  {
    print "No message header\n";
  }

if ($main::config_opts{$listname, "message_footer"} ne '')
  {
    my $footer = $main::config_opts{$listname, "message_footer"};
    $footer =~ s/\001|$/\n/g;
    my $footerfilename = $DATATARGETDIR . "/" . $ROBOT . "/" . $listname . "/message.footer";
    open footerfile, ">", $footerfilename
      or die "Could not open footer file $footerfilename: $!";
    print footerfile $footer;
    close footerfile;
    print "Wrote footer file\n";
 }
else
  {
    print "No message footer\n";
  }


############################################################################
# Grab subscribers and pipe them to sympa.pl --import
############################################################################

my $subscribersfilename = $LISTDIR . "/" . $listname;
open subscribersfile, "<", $subscribersfilename
 or die "couldn't open subscribers file: $!";

my $pipecmd = "|" . $SYMPA. " --import " . $listname . "\\@" . $ROBOT;
if ($thisisnotadrill)
  {
    open sympapipe, $pipecmd
      or die "Couldn't run $pipecmd: $!";
  }
else
  {
    print "Would normally now call $pipecmd";
  }

while (my $line = <subscribersfile>)
 {
   my @addrs = Mail::Address->parse($line);
   my $addr;
   foreach $addr (@addrs)
     {
       
       my $addline = $addr->address . " " . $addr->name . "\n";
       if ($thisisnotadrill)
         {
	   print sympapipe $addline;
	 }
       else
         {
	   print ".";
	 }
     }
 }
close subscribersfile;
if (!$thisisnotadrill) { print "\n"; }

#############################################################################
# Migrate archives
#############################################################################

my $listarchivedir = $ARCHIVEDIR . "/" . $listname;
if ((-e $listarchivedir) && (-d $listarchivedir))
  {
    print "Migrating archives... ";
    my @sourcefiles
      = glob($listarchivedir . "/" . $listname . ".[0-9][0-9][0-9][0-9]*");
    my $filename;
    my $lastmonth = 0;
    my $lastyear = 0;
    my $index = 0;
    my $dir;
    foreach $filename (@sourcefiles)
      {
        open infile, "<", $filename
          or die "Couldn't open $filename: $!";
        my @fields = split(/\./, $filename);
        my $suffix = $fields[1];
        my $year = substr($suffix, 0, 2);
        if ($year > $Y2KLINE)
          {
            $year = "19" . $year;
          }
        else
          {
            $year = "20" . $year;
          };
        my $month = substr($suffix, 2, 2);
        print "[$month/$year]";
        
        if (($lastmonth != $month) || ($lastyear != $year))
          {
            $dir = $ARCHIVETARGETDIR . "/" . $listname . "@" . $ROBOT
    	             . "/" . $year . "-" . $month . "/arctxt";
            mkpath ($dir)
              or die "Could not create directory $dir: $!";
       
            $lastmonth = $month;
    	    $lastyear = $year;
    	    $index = 0;
          }
        
        while (my $line = <infile>)
          {
            if ($line =~ /^From /)
    	      {
    	        if (tell(outfile) != -1)
    	          {
    	            close outfile;
                  }
    	        $index++;
    	        my $outfilename = $dir . "/" . $index;
    	        open outfile, ">", $outfilename
    	          or die "Could not create $outfilename: $!";
    	      }
    	    print outfile $line;
          }
        close outfile;
    
        close infile;
      }
      if (0 == $lastmonth)
        {
	  print "Archives empty\n";
	}
      print "\nNow regenerate your archives!\n";
  }
else
  {
    print "No archive directory to migrate\n";
  }