#!/usr/bin/perl -w
##
##  BDX.pm - XML Birthday Reminder package
##  Copyright (c) 2001 Leo Fellermayr <leosmail@mac.com>
##
##  $Id: BDX.pm,v 0.01 2001/06/21 15:27:18 leo Exp $

package BDX;

# ----- required modules

use DBI();
use HTML::Entities;
use MIME::QuotedPrint;
use Net::SMTP;
use XML::Parser;
use XML::Writer;
use Time::localtime;
use URI::Escape;

# ----- some global vars (specify if you want to)

my %xmldb = ();
my %today = ();
my ($d,$m,$y,$date);
my $notify_to = 'leo@prinzess.dyndns.org';
my $bdfile = '/wwwroot/prinzess.dyndns.org/html/dyndata/birthday.html';
my $mbdfile = '/wwwroot/prinzess.dyndns.org/html/db/monbir.html';
my $smslog = '/tmp/sms.log';
my $smsprog = '/wwwroot/prinzess.dyndns.org/bin/smswebde2.pl';
my $xmlbase = '/wwwroot/prinzess.dyndns.org/serverdata/birthday.xml';

# ================ write_xml (\%thehash)
#
# writes all messages from the given hash to the xml base
#

sub write_xml ($) {
  my $hash = shift;
  umask 002;
  $xmlbase = new IO::File (">$xmlbase") or die $!;
  my $xml = new XML::Writer (
    DATA_MODE   => 1,
    DATA_INDENT => 2,
    OUTPUT      => $xmlbase
    );
  $xml->xmlDecl ("ISO-8859-1", "no");
  $xml->doctype ("birthday", "", "birthday.dtd");
  $xml->startTag("birthday");

  foreach (@{$hash}) {
    $xml->startTag("bdr", "gebdat" => $$_{gebdat});
    $xml->startTag("name");
    $xml->characters (encode_qp ($$_{name}));
    $xml->endTag("name");
    $xml->startTag("email");
    $xml->characters (encode_qp($$_{email}));
    $xml->endTag("email");
    $xml->startTag("handy");
    $xml->characters (encode_qp($$_{handy}));
    $xml->endTag("handy");
    $xml->endTag("bdr");
  }

  $xml->endTag ("birthday");
  $xml->end;
  $xmlbase->close();
}

# ----- sql2xml ($dbname, $dbtable)
#
# extracts content of a MySQL data base to a given XML file using DBI/DBD
#

sub sql2xml ($$) {
  my ($dbname, $dbtable) = @_;
  my $dbh = DBI->connect("DBI:mysql:database=$dbname;host=localhost",
			"root", "", {'RaiseError' => 1});
  my $sth = $dbh->prepare("SELECT * FROM $dbtable");
  $sth->execute();
  my $sqlbase;
  while (my $ref = $sth->fetchrow_hashref()) {
    my %ds = (
      gebdat	=> $ref->{gebdat},
      name	=> $ref->{name},
      email	=> $ref->{email},
      handy	=> $ref->{handy}
    );
    push @{$sqlbase}, \%ds;
  }
  write_xml ($sqlbase);
  $sth->finish();
  $dbh->disconnect();
}

# ----- parse_xml ($xmlfile)
#
# Parses the xml file and returns a reference to the hash containing data
#

sub parse_xml ($) {

  my $xmlfile = shift;
  my %birthday = ();
  my $textbuffer = "";

  sub StartTag {
    my ($expat, $element) = @_;
    if ($element eq "bdr") {
      $birthday{gebdat} = $_{gebdat};
    }
  }

  sub Text {
    my $expat = shift;
    $textbuffer = $_;
  }

  sub EndTag {
    my ($expat, $element) = @_;
    if ($element eq "name") {
      $birthday{name} = decode_qp($textbuffer);
    } elsif ($element eq "email") {
      $birthday{email} = decode_qp($textbuffer);
      $birthday{email} =~ s/(\n)|(\s)//g; 
    } elsif ($element eq "handy") {
      $birthday{handy} = decode_qp($textbuffer);
      $birthday{handy} =~ s/(\n)|(\s)//g; 
    }
    if ($element eq "bdr") {
      my %this = %birthday;
      push @{$xmldb}, \%this;
    }
  }

  my $xml = new XML::Parser(Style => 'Stream', ErrorContext => 2);
  $xml->parsefile ($xmlfile);

  @{$xmldb} = sort { $$a{name} <=> $$b{name} } @{$xmldb};
}

# ================ bd_new (\%form)
#
# Adds the supplied CGI form to the bottom of the xml base.
#

sub bd_new ($) {
  my %form = @_;
  my $offset = $#{@{$xmldb}} - 5;
  push @{$xmldb}, \%form;
  write_xml ($xmldb);
  print "Location: http://prinzess.dyndns.org/db/birthday.php?offset=$offset\n\n";
}

# ================ bd_delete (\%form)
#
# Deletes an entry from the xml base, which must be specified
#

sub bd_delete ($) {
  my %form = @_;
  foreach (@{$xmldb}) {
    if (($$_{gebdat} ne $form{gebdat}) and ($$_{name} ne $form{name})) {
    my %this = (
      gebdat      => $$_{gebdat},
      name        => $$_{name},
      email	  => $$_{email},
      handy	  => $$_{handy}
      );
      push @{$new}, \%this;
    }
  }
  write_xml ($new);
  print "Location: http://prinzess.dyndns.org/db/birthday.php\n\n";
}

# ----- bd_admin ($offset, $perpage)
#
# shows a specified offset of the XML database formatted in HTML
#

sub bd_admin ($$) {

  print "Content-type: text/html\n\n";

  my ($offset, $perpage) = @_;
  $offset ||= 1;
  $perpage ||= 10;
  my $entries = $#{@{$xmldb}};

  if ($offset > $entries) {
    print "Offset > Anzahl Eintr&auml;ge in der Datenbank!";
    exit (0);
  }

  sub navig {
    if ($offset > $perpage) {
      $newoffset = $offset - $perpage - 1;
      print "<a href=\"birthday.php?offset=$newoffset\">Zur&uuml;ck</a>&nbsp;&nbsp;\n";
    }
    if ($entries > $offset + $perpage) {
      $newoffset = $offset + $perpage;
      print "<a href=\"birthday.php?offset=$newoffset\">Weiter</a>\n";
    }
  }

  my $i = 0;
  navig;
  print "<br /><br />\n<table border=\"0\">\n";
  foreach (@{$xmldb}) {
    $i++;
    if ($i % 2) { $color = " bgcolor=\"#dedede\""; }
    else { $color = " bgcolor=\"#f6f6f6\""; }
    if (($i >= $offset) and ($i <= $offset + $perpage - 1)) {
      print "<tr$color><td>$$_{gebdat}</td><td>" . encode_entities($$_{name}) . "</td>\n";
      if ($$_{email}) {
        $$_{email} = "<a href=\"mailto:$$_{email}\">$$_{email}</a>";
      }
      print "<td>$$_{email}</td><td>$$_{handy}</td>\n";
      print "<td><a href=\"/cgi-bin/bdadmin.pl?action=delete&gebdat=" . uri_escape($$_{gebdat}) . "&name=" . uri_escape($$_{name}) . "\">L&ouml;schen</a></td></tr>\n";
    }
  }
  print "</table>\n<br />\n";
  navig;
}

# ----- get_birthdays
#
# creates a hash containing people whose birthday is now
#

sub get_birthdays {
  my $age;
  foreach (@{$xmldb}) {
    my ($td, $tm, $ty) = split (/\./, $$_{gebdat});
    if (($td eq $d) and ($tm eq $m)) {
      $age = $y - $ty;
      my %this = ();
      %this = (
	age => $age,
	name => $$_{name},
	email => $$_{email},
	handy => $$_{handy},
	gebdat => $$_{gebdat}
      );
      push @{$today}, \%this;
    }
  }
}

# ----- various notifying subs for web, mail and console use

# ----- bd_web()
#
# prints html-formatted output (e.g., for CGI use)
#

sub bd_web {
  print "Content-type: text/html\n\n";
  my $i = 0;
  foreach (@{$today}) {
    $i++;
    if ($i > 1) { print ", "; }
    print encode_entities ($$_{name}) . " (" . encode_entities ($$_{age}) . ")";
  }
  if ($i eq 0) {
    print "Heute keine Geburtstage.\n";
  }
}

# ----- bd_mailnotify()
#
# sends notification to the webmaster ($notify_to) via e-mail
#

sub bd_mailnotify {
  if ($#{@{$today}} + 1 > 0) {
    my $smtp = Net::SMTP->new('localhost');
    $smtp->mail('bdx\@leoshome.de');
    $smtp->to($notify_to);
    $smtp->data();
    $smtp->datasend("From: XML Birthday Reminder <bdx\@leoshome.de>\n");
    $smtp->datasend("To: XMLBR-Verteiler\n");
    $smtp->datasend("X-Priority: 1\n");
    $smtp->datasend("Subject: Geburtstage am $date\n\n");
    $smtp->datasend("Geburtstage am $date:\n\n");
    foreach (@{$today}) {
      $smtp->datasend("- $$_{name} ($$_{age})\n");
    }
    $smtp->datasend("\n\n--\nBirthday Reminder\n(c) 2001 Leo Fellermayr (leosmail\@mac.com)\n");
    $smtp->dataend();
    $smtp->quit();
  }
}

# ----- bd_preload()
#
# saves birthday information for today into a HTML formatted file
#

sub bd_preload {
  open (BDFILE, ">$bdfile");
  $i = 0;
  foreach (@{$today}) {
    $i++;
    print BDFILE ", " if ($i > 1);
    if ($$_{email}) {
      print BDFILE "<a href=\"mailto:$$_{email}\">" . encode_entities($$_{name}) . "</a> ($$_{age})";
    }
    else {
      print BDFILE encode_entities($$_{name}) . " ($$_{age})";
    }
  }
  if ($i eq 0) {
    print BDFILE "Heute keine Geburtstage<br />\n";
  }
  close (BDFILE);
}

# ----- bd_month()
#
# prints birthdays in current month to a specified HTML file
#

sub bd_month {
  @{$xmldb} = sort { $$a{gebdat} <=> $$b{gebdat} } @{$xmldb};
  open (MBDFILE, ">$mbdfile");
  print MBDFILE "<table border=\"0\">\n";
  foreach (@{$xmldb}) {
    my ($hd, $hm, $hy) = split (/\./, $$_{gebdat});
    if ($hm eq $m) {


      $age = $y - $hy;
      if ($$_{email}) {
        print MBDFILE "<tr><td>$$_{gebdat}</td><td><a href=\"mailto:$$_{email}\">" . encode_entities($$_{name}) . "</a></td><td>$age</td></tr>\n";
      }
      else {
        print MBDFILE "<tr><td>$$_{gebdat}</td><td>" . encode_entities($$_{name}) . "</td><td>$age</td></tr>\n";
      }
    }
  }
  print MBDFILE "</table>\n";
  close (MBDFILE);
}

# ----- bd_gratulation()
#
# sends gratulation wishes to people who have birthday via e-mail and SMS
#

sub bd_gratulation {
  foreach (@{$today}) {
    if ($$_{email}) {
      my $smtp = Net::SMTP->new("localhost");
      $smtp->mail("glueckwunsch\@leoshome.de");
      $smtp->to($$_{email});
      $smtp->data();
      $smtp->datasend("From: Leonhard Fellermayr <glueckwunsch\@leoshome.de>\n");
      $smtp->datasend("To: $$_{name} <$$_{email}>\n");
      $smtp->datasend("Subject: Herzlichen Glueckwunsch\n\n");
      $smtp->datasend("      Hallo $$_{name},\n\nherzlichen Glückwunsch und alles Gute ");
      $smtp->datasend("zu Deinem Geburtstag wünscht Dir\n\n      Leo.\n");
      $smtp->dataend();
      $smtp->quit();
    }
    if ($$_{handy}) {
      open (SMSLOG, ">>$smslog");
      my $log = `$smsprog $$_{handy} "Hallo $$_{name}, herzlichen Glückwunsch zum Geburtstag. Leo Fellermayr."`;
      print SMSLOG $log;
      close (SMSLOG);
    }
  }
}

#
# ------- main program
#

# fetch data from MySQL data base
# this is usually needed only once for getting XML data

if (!(-e $xmlbase)) {
  sql2xml ("birthday", "birthday");
}

# get current date (day, month, year)

my $tm = localtime (time ());
$date = sprintf ("%02d.%02d.%04d",
  $tm->mday, $tm->mon + 1, $tm->year + 1900);
($d,$m,$y) = split (/\./, $date);

# parse the XML birthday file

if (-s $xmlbase) {
  parse_xml($xmlbase);		# read the complete db into %xmldb
}
else {
  print "error: xml base not found!";
  exit (0);
}

# get today's birthdays

get_birthdays();		# today's birthdays into %today

# now we are ready to handle all the specific notifying/messaging subs above

1;