#!/usr/bin/perl -w

use strict;

#   mklist - create some list documentation
#   Copyright (c) 1998  Martin Schulze <joey@debian.org>
#                 1998  James Treacy <treacy@debian.org>

#   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, write to the Free Software
#   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02111, USA.

my $progname = "mklist";

# ----- Begin of Customisation
#
# -t | --text
my $def_mlists = "mailing-lists.txt";
#
# -w | --web
my $def_weblists = $ENV{'HOME'} . "/lib/web/debian/mailing-lists.html";
#
# -s | --subscribe
my $def_subscribe = "subscribe.wml";
#
# -u | --unsubscribe
my $def_unsubscribe = "unsubscribe.wml";
#
# ----- End of Customisation

my @fieldlist = ('Language','Digest','Moderated','Subscription');
my @specialist = ('Section','Description');
my @globlist = ('List','Introduction','Subscription','Advertising');

# This refers to @grouptitle from master:/org/lists.debian.org/scripts/conf.pl
my @sections = ('user','devel','int','ports','bugs','misc','other','foreign');

my %list;

sub usage()
{
	printf "Maintain mailing lists  - Copyright (c) 1998 by Joey and Jay Treacy\n";
	printf "Usage: $progname [options]\n";
	printf "       -f cfg\t\t\tUse a different configuration file\n";
	printf "       -t|--text [fname]\tCreate mailing-lists.txt\n";
	printf "       -w|--web [fname]\t\tCreate mailing-lists.html (wmt format)\n";
	printf "       -s|--subscribe [fname]\tCreate subscribe.wml\n";
	printf "       -u|--unsubscribe [fname]\tCreate subscribe.wml\n";
}

sub fieldname
{
	foreach my $field (@fieldlist,@specialist,@globlist,@sections,"Alias") {
		return $field if ($_[0] =~ /$field/i);
	}
}

sub read_config
{
	my $conf = shift;
	my $field;
	my $mylist = "";

	open CONF, $conf or die "can't open $conf: $!";
	%list = ();		# Reset global structure
	while (<CONF>) {
		next if (/^\#/);
		next if (/^\s*$/);

		# select multiline fields
		if (/^\s+/) {
			s/^\s+//;
			$list{$mylist}->{$field} .= $_;
		} else {
			if (/^([a-z]+)\s*:\s*(.*)$/i) {
				$field = &fieldname($1);
				if ($field eq "Alias") {
					$mylist = $2;
				}
				elsif ($field eq "List") {
					$mylist = $2;
				}
				else {
					$list{$mylist}->{$field} = $2;
				}
			}
		}
	}
	close CONF;

	foreach my $l (keys %list) {
	  (my $shortname = $l) =~ s/@.*$//;
	  my $descfile = "desc/$list{$l}{Section}/$shortname";
	  $descfile = "../../english/MailingLists/$descfile" if (! -f $descfile);
	  $list{$l}{Description} = `cat $descfile` if ( -f $descfile);
	}
	foreach my $s (@sections) {
	  my $descfile = "desc/$s.heading";
	  $descfile = "../../english/MailingLists/$descfile" if (! -f $descfile);
	  die "can't find $descfile: $!" if (! -f $descfile);
          if (not exists $list{''}{$s}) {
	    $list{''}{$s} = `cat $descfile`;
	  }
	}
	foreach my $i (@globlist) {
	  next if ($i eq "List");
	  my $descfile = "desc/" . lc $i;
	  $descfile = "../../english/MailingLists/$descfile" if (! -f $descfile);
	  die "can't find $descfile: $!" if (! -f $descfile);
          if (not exists $list{''}{$i}) {
	    $list{''}{$i} = `cat $descfile`;
	  }
	}
}

sub print_multiline_txt
{
    my $space = shift;
    my $lines = shift;
    my @lines = @$lines;

    my $i=1;
    while ($i <= $#lines) {
	if ($lines[$i] eq ".") {
	    print OUT "\n";
	} else {
	    printf OUT "%s%s\n", $space, $lines[$i];
	}
	$i++;
    }
}

sub print_multiline_html
{
    my $space = shift;
    my $lines = shift;
    my @lines = @$lines;

    my $i=1;
    while ($i <= $#lines) {
	if ($lines[$i] eq ".") {
	    printf OUT "%s<br><br>\n", $space;
	} else {
	    printf OUT "%s%s\n", $space, $lines[$i];
	}
	$i++;
    }
}

sub write_mailing_lists_txt
{
	open OUT, ">$_[0]" or die "can't open $_[0]: $!";

	my @lines = split(/\n/,$list{''}->{'Introduction'});

	my $amount = (76 - length($lines[0])) / 2;
	my $space = " " x $amount;
	printf OUT "%s%s\n%s", $space, $lines[0], $space;
	$space = "=" x length($lines[0]);
	printf OUT "%s\n\n", $space;
	&print_multiline_txt("  ",\@lines);

	@lines = split(/\n/,$list{''}->{'Subscription'});
	$space = "-" x length($lines[0]);
	printf OUT "\n%s\n%s\n\n", $lines[0], $space;
	&print_multiline_txt("  ",\@lines);

	foreach my $section (@sections) {
		my @lists = ();
		foreach my $l (keys(%list)) {
			next if (!$l || ($list{$l}->{'Section'} ne $section));
			push(@lists, $l);
		}
		@lists = sort @lists;

		if ($#lists > -1) {
			die "can't find description of the section $section!\n" unless exists $list{''}->{$section};
			my @lines = split(/\n/,$list{''}->{$section});
			printf OUT "\n%s\n\n", $lines[0];
			&print_multiline_txt("  ",\@lines);

			foreach my $l (@lists) {
				printf OUT "\n  %s\n\n", $l;
				die "$l has no description!\n" unless $list{$l}->{'Description'};
				@lines = split(/\n/,$list{$l}->{'Description'});
				printf OUT "      Description : %s\n", $lines[0];
				&print_multiline_txt("                    ",\@lines);

				foreach my $field (@fieldlist) {
					printf OUT "      %-12s: %s\n", $field, $list{$l}->{$field}
					if (exists $list{$l}->{$field});
				}
			}
		}
	}

	@lines = split(/\n/,$list{''}->{'Advertising'});
	$space = "-" x length($lines[0]);
	printf OUT "\n\n%s\n%s\n\n", $lines[0], $space;
	&print_multiline_txt("  ",\@lines);

	print OUT "\n";
	print OUT "-- \n";
	print OUT "Online HTML version of this document is available at\n";
	print OUT "	https://www.debian.org/MailingLists/subscribe\n";
}

sub write_mailing_lists_html
{
    open OUT, ">$_[0]" or die "can't open $_[0]: $!";

    print OUT <<"EOF";
wm::destination=~/public_html/Linux/Debian/master/mailing-lists.html
wm::template=debian.wmt
meta::description=Mailing lists served by Debian, the universal operating system.
meta::keywords=Debian, Linux, GNU, Mailing list
link::US=https://people.debian.org/~joey/
link::Europe=http://www.infodrom.north.de/~joey/Linux/Debian/master/

head::title=Mailing lists served by the Debian Project
body::title=Mailing lists served by the Debian Project
body::links=
<font face="Arial,Helvetica"><b><a href="http://www.infodrom.north.de/Debian/user.html">#Debian</a></b></font><p>
<font face="Arial,Helvetica"><b><a href="pr/">Public Relations</a></b></font></p><p>
<font face="Arial,Helvetica"><b><a href="goals/">Our Goals</a></b></font></p><p>
<font face="Arial,Helvetica"><b><a href="links.html">Links</a></b></font><br>
<font face="Arial,Helvetica"><b><a href="machines.html">Machines</a></b></font><br></p>
<p><br></p><p>
<b>Sections</b><br></p>
EOF
    foreach my $section (@sections) {
	printf OUT "&nbsp;<a href=\"#%s\">%s</a><br>\n", $section, $section;
    }

    print OUT "body::text=\n";

    my @lines = split(/\n/,$list{''}->{'Introduction'});
    printf OUT "<h1>%s</h1>\n", $lines[0];
    &print_multiline_html("  ",\@lines);

    @lines = split(/\n/,$list{''}->{'Subscription'});
    printf OUT "\n<h2>%s</h2>\n\n", $lines[0];
    &print_multiline_html("  ",\@lines);

    foreach my $section (@sections) {
        my @lists = ();
        foreach my $l (keys(%list)) {
	    next if (!$l || ($list{$l}->{'Section'} ne $section));
	    die "$l has no description!\n" unless $list{$l}->{'Description'};
	    push(@lists, $l);
        }
        @lists = sort @lists;

        if ($#lists > -1) {
	    die "can't find description of the section $section!\n" unless exists $list{''}->{$section};
	    my @lines = split(/\n/,$list{''}->{$section});
	    printf OUT "\n<hr><h3><a name=\"%s\">%s</a></h3>\n\n", $section, $lines[0];
	    &print_multiline_html("  ",\@lines);

	    foreach my $l (@lists) {
	        printf OUT "\n<p><b>%s</b></p>\n\n", $l;
	        my @lines = split(/\n/,$list{$l}->{'Description'});
	        printf OUT "      Description :<br>\n<blockquote>\n  %s\n", $lines[0];
	        &print_multiline_html("  ",\@lines);
	        print  OUT "</blockquote>\n";

	        foreach my $field (@fieldlist) {
			printf OUT "      %-12s: %s<br>\n", $field, $list{$l}->{$field}
				if (exists $list{$l}->{$field});
	        }
	    }
        }
    }

    @lines = split(/\n/,$list{''}->{'Advertising'});
    printf OUT "\n\n<hr><h2>%s</h2>\n\n", $lines[0];
    &print_multiline_html("  ",\@lines);

    print OUT "\nbody::address=<address>&#169; automatically generated</address>\n";
}

sub write_mailing_lists_subscribe
{
	open OUT, ">$_[0]" or die "can't open $_[0]: $!";

	print OUT <<"EOF";
#include "\$(ENGLISHDIR)/MailingLists/mklist.tags"
#use wml::debian::template title="<subscribe_title>"

<!-- This page is generated automatically by the mklist script, do not edit -->

EOF
#	my @lines = split(/\n/,$list{''}->{'Introduction'});
#	printf OUT "<h1>%s</h1>\n", $lines[0];
#	&print_multiline_html("  ",\@lines);

#	$list{''}->{'Subscription'} =~ s/>/&gt;/g;
#	$list{''}->{'Subscription'} =~ s/</&lt;/g;
#	$list{''}->{'Subscription'} =~ s,(http://[\w.\-~/]*),<a href="$1">$1</a>,g;
#	$list{''}->{'Subscription'} =~ s,(listmaster@[\w.-]*),<a href="mailto:$1">$1</a>,g;
#	$list{''}->{'Subscription'} =~ s,(majordomo@[\w.-]*),<a href="mailto:$1">$1</a>,g;
#	@lines = split(/\n/,$list{''}->{'Subscription'});
#	printf OUT "\n<h2>%s</h2>\n\n", $lines[0];
#	&print_multiline_html("  ",\@lines);

	print OUT <<END;
<p><see_also_subscribe></p>
<p><mail_address_warn></p>

<hr>

<p><select_subscribe></p>

<form method="post" action="https://lists.debian.org/cgi-bin/subscribe.pl">
END

	foreach my $section (@sections) {
		my @lists = ();
		foreach my $l (keys(%list)) {
			next if (!$l || ($list{$l}->{'Section'} ne $section));
			die "$l has no description!\n" unless $list{$l}->{'Description'};
			die "$l has no subscription policy!\n" unless $list{$l}->{'Subscription'};
			next unless exists $list{$l}->{'Moderated'}; # weeds out external lists
			next unless $list{$l}->{'Subscription'} =~ /^open/;
			push(@lists, $l);
		}
		@lists = sort @lists;

		if ($#lists > -1) {
			die "can't find description of the section $section!\n" unless exists $list{''}->{$section};
			my @lines = split(/\n/,$list{''}->{$section});
			printf OUT "\n<h3><a name=\"%s\">%s</a></h3>\n\n", $section, $lines[0];
                        if ( scalar(@lines) > 1 ) {
			    print OUT "<p>\n";
			    &print_multiline_html("  ",\@lines);
			    print OUT "</p>\n";
                        }
			print OUT "<DL>\n";
			foreach my $l (@lists) {
				my $slist = $l; $slist =~ s/@.*//;
				printf OUT "<DT><INPUT TYPE=\"checkbox\" NAME=\"subscribe\" VALUE=\"%s\">\n", $slist;

				# this fixes #445010, which is an annoying bug.
				# this is hacked this way in order to only mess with the output part
				# of the subscribe script generation, instead of modifying our whole
				# process for foreign lists.
				#  - damog@d.o, mar 14, 2009
				if($slist =~ /\Aother\-(.+?)\z/) {
					printf OUT "  <STRONG><a name=\"%s\" href=\"https://lists.debian.org/%s/\">%s</a></STRONG>", $1, $1, $1;
				} else {	
					printf OUT "	<STRONG><a name=\"%s\" href=\"https://lists.debian.org/%s/\">%s</a></STRONG>", $slist, $slist, $slist;
				}

				$list{$l}->{'Description'} =~ s/&/&amp;/g;
				$list{$l}->{'Description'} =~ s/>/&gt;/g;
				$list{$l}->{'Description'} =~ s/</&lt;/g;
				$list{$l}->{'Description'} =~ s,(http://[\w.\-~/#]*),<a href="$1">$1</a>,g;
				$list{$l}->{'Description'} =~ s,(https://[\w.\-~/#]*),<a href="$1">$1</a>,g;
				$list{$l}->{'Description'} =~ s,(listmaster@[\w.-]*),<a href="mailto:$1">$1</a>,g;
				$list{$l}->{'Description'} =~ s,(majordomo@[\w.-]*),<a href="mailto:$1">$1</a>,g;
				my @lines = split(/\n/,$list{$l}->{'Description'});
				printf OUT "\n\n	<DD>%s\n", $lines[0];
				&print_multiline_html("	",\@lines);
				if ($list{$l}->{'Moderated'} eq "yes") {
					printf OUT "	<BR><moderated> <em><yes></em>&nbsp;&nbsp;&nbsp;&nbsp;\n";
				} elsif ($list{$l}->{'Moderated'} eq "no") {
					printf OUT "	<BR><moderated> <em><no></em>&nbsp;&nbsp;&nbsp;&nbsp;\n";
				} elsif ($list{$l}->{'Moderated'} eq "subscribers") {
					printf OUT "	<BR><em><posting_only_subscribers></em>&nbsp;&nbsp;&nbsp;&nbsp;\n";
				} elsif ($list{$l}->{'Moderated'} eq "signed") {
					printf OUT "	<BR><em><posting_only_signed></em>&nbsp;&nbsp;&nbsp;&nbsp;\n";
				} else { die "unknown moderated value for $l" }
				die "no subscription policy for $l\n" unless defined $list{$l}{'Subscription'};
				printf OUT "	<subscription> <em><open></em>\n";
				if (exists $list{$l}->{'Digest'}) {
					$slist = $list{$l}->{'Digest'}; $slist =~ s/@.*//;
					printf OUT "	<BR><INPUT TYPE=\"checkbox\" NAME=\"subscribe\" VALUE=\"%s\">\n", $slist;
					printf OUT "	<STRONG>%s</STRONG> <digest>\n", $slist;
				}
				print OUT "\n";
			}
			print OUT "</DL>\n";
		}
	}
	print OUT "<HR>\n<p><STRONG><your_email></STRONG>\n";
	print OUT "<BR><INPUT TYPE=\"text\" NAME=\"user_email\" SIZE=\"60\"><BR>\n";
	print OUT "<INPUT TYPE=\"SUBMIT\" VALUE=\"<subscribe>\"> <INPUT TYPE=\"RESET\" VALUE=\"<clear>\">\n";
	print OUT "</p>\n</FORM>\n\n";

	print OUT <<END;
<p><respect_ad_policy></p>
END

#	@lines = split(/\n/,$list{''}->{'Advertising'});
#	printf OUT "\n\n<hr><h2>%s</h2>\n\n", $lines[0];
#	&print_multiline_html("  ",\@lines);
}

sub write_mailing_lists_unsubscribe
{
	open OUT, ">$_[0]" or die "can't open $_[0]: $!";

	print OUT <<"EOF";
#include "\$(ENGLISHDIR)/MailingLists/mklist.tags"
#use wml::debian::template title="<unsubscribe_title>"

<!-- This page is generated automatically by the mklist script, do not edit -->

EOF
#	$list{''}->{'Subscription'} =~ s/>/&gt;/g;
#	$list{''}->{'Subscription'} =~ s/</&lt;/g;
#	$list{''}->{'Subscription'} =~ s,(http://[\w.\-~/]*),<a href="$1">$1</a>,g;
#	$list{''}->{'Subscription'} =~ s,(listmaster@[\w.-]*),<a href="mailto:$1">$1</a>,g;
#	$list{''}->{'Subscription'} =~ s,(majordomo@[\w.-]*),<a href="mailto:$1">$1</a>,g;
#	my @lines = split(/\n/,$list{''}->{'Subscription'});
#	printf OUT "\n<h2>%s</h2>\n\n", $lines[0];
#	&print_multiline_html("  ",\@lines);

	print OUT <<END;
<p><see_also_unsubscribe></p>

<hr>

<p><select_unsubscribe></p>

<form method="post" action="https://lists.debian.org/cgi-bin/subscribe.pl">
END

	foreach my $section (@sections) {
	    my @lists = ();
	    foreach my $l (keys(%list)) {
		next if (!$l || ($list{$l}->{'Section'} ne $section));
		next unless exists $list{$l}->{'Description'};
		next unless exists $list{$l}->{'Moderated'}; # weeds out external lists
		die "$l has no subscription policy!\n" unless exists $list{$l}->{'Subscription'};
		next unless $list{$l}->{'Subscription'} =~ /^open/;
		push(@lists, $l);
	    }
	    @lists = sort @lists;

	    if ($#lists > -1) {
		die "can't find description of the section $section!\n" unless exists $list{''}->{$section};
		my @lines = split(/\n/,$list{''}->{$section});
		printf OUT "\n<h3><a name=\"%s\">%s</a></h3>\n\n", $section, $lines[0];
		# &print_multiline_html("  ",\@lines);

                print OUT "<table summary=\"$lines[0]\">\n";
                my $count = 0;
		foreach my $l (@lists) {
		    my $slist = $l; $slist =~ s/@.*//;
		    if (! ($count++ % 3) ) {
			print OUT "\n</tr>\n" unless ($count < 3);
			print OUT "\n<tr>\n";
		    }
		    # Use similar hack used to fix #445010 to take care of #522324
		    if($slist =~ /\Aother\-(.+?)\z/) {
			printf OUT "\t<td><input type=\"checkbox\" name=\"unsubscribe\" ".
				   "value=\"%s\">\n\t<strong><a name=\"%s\" href=\"https://lists.debian.org/%s/\">%s</a></strong>".
				   "<br>\n", $slist, $1, $1, $1;
		    } else {
			printf OUT "\t<td><input type=\"checkbox\" name=\"unsubscribe\" ".
				   "value=\"%s\">\n\t<strong><a name=\"%s\" href=\"https://lists.debian.org/%s/\">%s</a></strong>".
				   "<br>\n", $slist, $slist, $slist, $slist;
		    }
		    if (exists $list{$l}->{'Digest'}) {
			$slist = $list{$l}->{'Digest'}; $slist =~ s/@.*//;
			if (! ($count++ % 3) ) {
			    print OUT "\n<tr>\n";
			}
			printf OUT "\t<td><input type=\"checkbox\" name=\"unsubscribe\" ".
			           "value=\"%s\">\n\t<strong><a name=\"%s\">%s</a></strong>".
			           "<br>\n", $slist, $slist, $slist;
		    }
		    print OUT "\n";
		}
		while ($count++ % 3) {
		    print OUT "\t<td>\n";
		}
                print OUT "</tr>\n";
                print OUT "</table>\n";
	    }
	}
	print OUT "<HR>\n<p><STRONG><your_email></STRONG>\n";
	print OUT "<BR><INPUT TYPE=\"text\" NAME=\"user_email\" SIZE=\"60\"><BR>\n";
	print OUT "<INPUT TYPE=\"SUBMIT\" VALUE=\"<unsubscribe>\"> <INPUT TYPE=\"RESET\" VALUE=\"<clear>\">\n";
	print OUT "</p>\n</FORM>\n\n";

	print OUT <<END;
<p><respect_ad_policy></p>
END
}

# First check our arguments
#
if ($#ARGV == -1) {
    &usage();
    exit;
}
my $opt_conf = "lists.cfg";
my @opt_files = ();
my $opt_mlists = "";
my $opt_weblists = "";
my $opt_subscribe = "";
my $opt_unsubscribe = "";
my $i = 0;
while ($i <= $#ARGV) {
    if ($ARGV[$i] eq "-h" || $ARGV[$i] eq "--help") {
        &usage();
        exit;
    } elsif ($ARGV[$i] eq "-f") {
	if ($i+1 <= $#ARGV) {
	    $i++;
	    $opt_conf = $ARGV[$i];
	}
    } elsif ($ARGV[$i] eq "-t" || $ARGV[$i] eq "--text") {
	if ($i+1 <= $#ARGV && $ARGV[$i+1] !~ /^-/) {
	    $i++;
	    $opt_mlists = $ARGV[$i];
	} else {
	    $opt_mlists = $def_mlists;
	}
    } elsif ($ARGV[$i] eq "-s" || $ARGV[$i] eq "--subscribe") {
	if ($i+1 <= $#ARGV && $ARGV[$i+1] !~ /^-/) {
	    $i++;
	    $opt_subscribe = $ARGV[$i];
	} else {
	    $opt_subscribe = $def_subscribe;
	}
    } elsif ($ARGV[$i] eq "-u" || $ARGV[$i] eq "--unsubscribe") {
	if ($i+1 <= $#ARGV && $ARGV[$i+1] !~ /^-/) {
	    $i++;
	    $opt_unsubscribe = $ARGV[$i];
	} else {
	    $opt_unsubscribe = $def_unsubscribe;
	}
    } elsif ($ARGV[$i] eq "-w" || $ARGV[$i] eq "--web") {
	if ($i+1 <= $#ARGV && $ARGV[$i+1] !~ /^-/) {
	    $i++;
	    $opt_weblists = $ARGV[$i];
	} else {
	    $opt_weblists = $def_weblists;
	}
    } elsif ($ARGV[$i] eq "-m") {
	if ($i+1 <= $#ARGV && $ARGV[$i+1] !~ /^-/) {
	    $i++;
	    $opt_mlists = $ARGV[$i];
	}
    } else {
	push(@opt_files, $ARGV[$i]);
    }
    $i++;
}

if ( -r $opt_conf ) {
  &read_config($opt_conf);
} else {
  die "Can't read $opt_conf file!\n";
}

&write_mailing_lists_txt($opt_mlists) if ($opt_mlists);
&write_mailing_lists_html($opt_weblists) if ($opt_weblists);
&write_mailing_lists_subscribe($opt_subscribe) if ($opt_subscribe);
&write_mailing_lists_unsubscribe($opt_unsubscribe) if ($opt_unsubscribe);