#!/usr/bin/perl

# What is it ?
#
# Many many times, I've discovered Debian packages only with the help
# of the hazard. There are so many Debian packages that it's
# impossible to know what they do. Of course, all the major packages
# are well-known, but there are many unknown tiny packages that might
# be very useful.
#
# There was already the Debian Package a Day's Journal, but it was not
# enough in my opinion. Personnaly, I prefer to receive informations
# in my mailbox. That's why I've coded a small Perl script, called
# through a crontab, that sends an e-mail to a mailing-list every day
# with the description of a Debian package.
#
# How to subscribe ?
#
# To subscribe to Daily Debian Package a day, simply go to
# http://the-doors.enix.org/cgi-bin/mailman/listinfo/daily-debian-package
# where you'll find a regular mailing-list manager.
#
# How does it work ?
#
# A Perl script is called every day by Cron. The Perl script downloads
# the new Packages.bz2 files from ftp.fr.debian.org. Currently, it
# downloads the Packages files from main in binary-i386 and non-free
# in binary-i386. Both Packages files are merged, and a custom
# Category tag is added to each package so that we know if the package
# comes from main or non-free.
#
# Then, the scripts randomly selects a package and checks if the
# package has not already been described to the list. If yes, then an
# other random package is chosen until we find a package whose
# description has never been sent to the list.
#
# Once we got the name of the package, we find its descriptions in the
# Packages file, format a mail, and send it.
#
# Web : http://thomas.enix.org/wakka.php?wiki=DebianPackageDay
#
#   Copyright (C) 2004 Thomas Petazzoni
#                      thomas.petazzoni@enix.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., 675 Mass Ave, Cambridge, MA 02139, USA.

use File::Basename;
use Text::Wrap;
use Net::SMTP;

# Hostname of the FTP server from which Packages files will be
# fetched.
$ftp_server = "ftp.fr.debian.org";

# Directory of the FTP mirror on the server
$ftp_dir    = "debian/";

# Lists of packages files to use
@pkg_lists = ( [ "unstable", "main", "binary-i386" ],
	       [ "unstable", "non-free", "binary-i386" ]);

# The SMTP host name through which mails will be sent
$smtp_host  = "localhost";

# The destination email address (currently a mailing list handled by
# Mailman)
$destination_email = "daily-debian-package\@enix.org";

# Want debug ?
$debug = 0;

# Add the "Category" tag to all packages of a Packages file
#
# The category tag is added to be able to distinguish packages coming
# from main from packages coming from non-free.
#
# Arg 0 : name of the input Packages file
# Arg 1 : name of the output Packages file
# Arg 2 : name of the category
#
# Returns nothing
sub AddPackagesCategory {
    my $infilename  = $_[0];
    my $outfilename = $_[1];
    my $category = $_[2];

    if($debug > 0)
    {
	print "Adding category tag\n";
    }

    # Open files
    open(PKG, '<' , $infilename) or die "Couldn't open file";
    open(OUTPKG, '>>', $outfilename) or die "Couldn't open file";

    while(<PKG>)
    {
	chomp;

	# Transfer each line of the input Packages file to the output
	# Packages file
	print OUTPKG $_ . "\n";

	# After the Package: line, add the Category: line
	if(m/^Package:/)
	{
	    print OUTPKG "Category: " . $category . "\n";
	}
    }

    close(OUTPKG);
    close(PKG);
}

# This procedure download the Packages files and concatenates them
# into a single Packages file.
#
# Returns nothing
sub DownloadPackages {

    if($debug > 0)
    {
	print "Downloading packages\n";
    }

    # Remove existing files
    unlink <Packages*>;

    # For each Package file
    for $i (0 ... $#pkg_lists)
    {
	$dir = "/" . $ftp_dir . "dists/" .
	    $pkg_lists[$i][0] . "/" .
	    $pkg_lists[$i][1] . "/" .
	    $pkg_lists[$i][2] . "/";

	# Download it
	system("wget -q ftp://" . $ftp_server . $dir . "Packages.bz2");

	$filename = "Packages." . $pkg_lists[$i][0] . "_" .
	    $pkg_lists[$i][1] . "_" . $pkg_lists[$i][2];

	# Uncompress it
	system("bunzip2 -c Packages.bz2 > " . $filename);
	system("rm Packages.bz2");

	AddPackagesCategory($filename, "Packages", $pkg_lists[$i][1]);
    }

    # Remove temporary files
    unlink <Packages.*>;
}

# Count the number of packages listed in the file named Packages
#
# Returns the number of packages
sub CountPackages {
    $pkg_count = 0;

    unless (open(PACKAGES, "Packages"))
    {
	die "Couldn't open Packages file\n";
    }

    while(<PACKAGES>)
    {
	if(/^Package:/)
	{
	    $pkg_count++;
	}
    }

    close(PACKAGES);

    return $pkg_count;
}

# Checks whether the description of a package has already been sent to
# the list using a small data base.
#
# Arg 0 : the name of the package
#
# Returns 1 when the package has already been sent, 0 otherwise
sub PackageAlreadySent {

    unless (open(PKGDB, "pkg.db"))
    {
	return 0;
    }

    while(<PKGDB>)
    {
	($date, $pkg) = /^([0-9\-]*):(.*)$/;

	if($pkg eq $_[0])
	{
	    close(PKGDB);
	    return 1;
	}
    }

    close(PKGDB);

    return 0;
}

# Find the name of a package using the ID of the package (the ID is
# the number of the package in the Packages file)
#
# Arg 0 : ID of the package
#
# Returns the name of the package if found, nothing otherwise
sub PackageName {
    my $id = $_[0];
    my $count = 0;

    unless (open(PACKAGES, "Packages"))
    {
	die "Couldn't open Packages file\n";
    }

    while(<PACKAGES>)
    {
	if(m/^Package: (.*)$/)
	{
	    if($id == $count)
	    {
		close(PACKAGES);
		return $1;
	    }

	    $count++;
	}

    }

    close(PACKAGES);

    return;
}

# Find the ID of a package using its name
#
# Arg 0 : name of the package
#
# Returns the ID of the package if found, nothing otherwise
sub PackageId {
    my $name = $_[0];
    my $count = 0;

    unless (open(PACKAGES, "Packages"))
    {
	die "Couldn't open Packages file\n";
    }

    while(<PACKAGES>)
    {
	if(m/^Package: (.*)$/)
	{
	    if($1 eq $name)
	    {
		return $count;
	    }

	    $count++;
	}

    }

    close(PACKAGES);

    return;
}

# Register a package to the "already-sent-packages" database, so that
# it won't be considered again.
#
# Arg 0 : name of the package
#
# Returns nothing
sub RegisterPackageToDb {
    my $name = $_[0];

    unless (open(PKGDB, ">>pkg.db"))
    {
	die "Couldn't open pkg.db file\n";
    }

    my ($sec,$min,$hour,$mday,$mon,$year,
	$wday,$yday,$isdst) = localtime time;

    # Add the name of the package with a timestamp
    printf(PKGDB "%.4d-%.2d-%.2d:%s\n",
	   $year+1900, $mon+1, $mday, $name);

    close(PKGDB);
}

# Wrap text
#
# Arg 0 : the input text
#
# Returns the wrapped text
sub WrapText {
    $Text::Wrap::columns = 72;
    return wrap('', '', $_[0]);
}

# Generates the final mail to be sent
#
# Arg 0 : ID of the package
# Arg 1 : name of the package
#
# Returns (text, subject) where text is the body of the message and
# subject .. the subject ;-)
sub GenerateText {

    my $id = $_[0];
    my $name = $_[1];

    unless (open(PACKAGES, "Packages"))
    {
	die "Couldn't open Packages file\n";
    }

    my $i = 0;

    # Scroll down in the Packages until we find the package we're
    # considering.
    while(<PACKAGES>)
    {
	if(m/^Package: /)
	{
	    if($i == $id)
	    {
		last;
	    }

	    $i++;
	}
    }

    my $section;
    my $installed_size;
    my $maintainer;
    my $version;
    my $short_desc;
    my $long_desc;
    my $category;

    # Extract interesting fields
    while(<PACKAGES>)
    {
	chomp;

	if(m/^Section: (.*)$/)
	{
	    $section = $1;
	}
	elsif(m/^Category: (.*)$/)
	{
	    $category = $1;
	}
	elsif(m/^Installed-Size: (.*)$/)
	{
	    $installed_size = $1;
	}
	elsif(m/^Maintainer: (.*)$/)
	{
	    $maintainer = $1;
	}
	elsif(m/^Version: (.*)$/)
	{
	    $version = $1;
	}
	elsif(m/^Description: (.*)$/)
	{
	    $short_desc = $1;
	}
	elsif(m/^ (.+)$/)
	{
	    # In Packages files, in the long description, empty lines
	    # are lines with '.'
	    if($1 eq ".")
	    {
		$long_desc .= "\n";
	    }
	    else
	    {
		$long_desc .= $1 . "\n";
	    }
	}
	elsif(length($_) < 1)
	{
	    last;
	}
    }

    # Generate the mail
    my $text = "Hello,\n\n";

    $text .= "Today, I'm happy to present you the Debian package "
    . $name . ", which is part of the " . $section .
    " section, and maintained by " . $maintainer . ". ";

    if($category eq "non-free")
    {
	$text .= "Be careful, this package is in the non-free section !";
    }

    $text .= "\n\n";

    $text .= "This package contains : " . $short_desc . ".\n";

    $text = WrapText($text);

    $text .= "\n";

    # This part is not rewrapped because it is already wrapped in the
    # Packages file, and because rewrapping breaks the lists.
    $text .= $long_desc;

    $text .= "\n\n";

    $text .= "Package homepage     :\n http://packages.debian.org/unstable/" . $section . "/" . $name . "\n\n";

    $text .= "Package bug homepage :\n http://bugs.debian.org/" . $name . "\n\n";

    $text .= "Package QA homepage  :\n http://packages.qa.debian.org/" . $name . "\n\n";

    $text .= "Have fun with Debian packages !\n\n";

    $text .= "-- \n";
    $text .= "Daily Debian package, by Thomas Petazzoni, thanks to Jérome Petazzoni\n";
    $text .= "Daily-debian-package\@the-doors.enix.org\n";
    $text .= "http://the-doors.enix.org/cgi-bin/mailman/listinfo/daily-debian-package\n";
    $text .= "http://thomas.enix.org/wakka.php?wiki=DebianPackageDay\n";

    my $subject = $name . " : " . $short_desc;

    return ($text, $subject);
}

# Sends the mail
#
# Arg 0 : the subject of the mail
# Arg 1 : the body of the mail
#
# Returns nothing
sub SendMessage {
    my $subject = $_[0];
    my $text = $_[1];

    $smtp = Net::SMTP->new($smtp_host);

    die "Couldn't connect to SMTP server " . $smtp_host unless $smtp;

    $smtp->mail("daily-debian-package\@enix.org");
    $smtp->to($destination_email);
    $smtp->data();
    $smtp->datasend("From: daily-debian-package\@enix.org\n");
    $smtp->datasend("To: " . $destination_email . "\n");
    $smtp->datasend("Subject: " . $subject . "\n");
    $smtp->datasend("\n");
    $smtp->datasend($text);
    $smtp->dataend();

    $smtp->quit;
}

####### Main part #########

DownloadPackages();

my $count = CountPackages();
my $packet_found = -1;
my $packet_name;

# For test purposes only : if an argument is given, it's the name of
# package we specifically want to send.
if($#ARGV == 0)
{
    $packet_name  = $ARGV[0];
    $packet_found = PackageId($packet_name);
}

while($packet_found == -1)
{
    my $nb = int(rand($count));

    my $name = PackageName($nb);

    my $alreadySent = PackageAlreadySent($name);

    if($alreadySent == 0)
    {
	$packet_found = $nb;
	$packet_name  = $name;
    }
}

RegisterPackageToDb($packet_name);

my ($text, $subject) = GenerateText($packet_found, $packet_name);

SendMessage($subject, $text);