#!/usr/bin/perl -w
#by Torben Menke
#http://www.entorb.net
# Script for generating a list of the next birthdays of people in your addressbook
# supports 'KDE kaddressbook' and 'Mozilla Thunderbird'
# A list of all birthdays can be created by uncommenting the last few lines.

use strict;
use warnings;
use Data::Dumper;
use Time::Local;
use Encode;


#------
# Windows cmd.exe uses cp850 as encoding
#binmode(STDOUT, ':encoding(cp850)');
# Linux uses utf-8
binmode(STDOUT, ':encoding(utf-8)');

my @contactlist = ();

# how many persons bdays to show in past+future
my $pastpeople = 7;
my $futurepeople = 14;
# alternative: now many days do we look around?
my $pastdays = 3;
my $futuredays = 7;

if (@ARGV and $_ = $ARGV[0] and m/^\-?\d+$/) { # check if numeric
if ($_ > 0 and $_ < 367) {
$futuredays = $_;
}
elsif ($_ < 0 and abs($_) < 367) {
$pastdays = -$_;
}
}

my $str;
my ($sec,$min,$hour,$today_mday,$today_mon,$today_year,$wday,$yday,$isdst) = localtime(time);
my $timetoday = timelocal(0, 0, 0, $today_mday, $today_mon, $today_year);
$today_year += 1900;
$today_mon += 1;



# sub definitions


sub readKDEvcf {
my $addressbook = shift;
my ($file, @file);
my $splitter = '--!--';

#read file
open INPUT , '<', $addressbook or die "Can't Open file, because $!";
binmode INPUT, ":utf8";
$file = join '' , <INPUT>;
close INPUT;

#ensure that every vcard starts in a new line
$file =~ s/(BEGIN:VCARD).*/\n$splitter/g;

@file = split "\n", $file;

#clean all but the interesting lines
@file = grep {/^($splitter|N:|BDAY:)/} @file;
shift @file; #removes first line (first BEGIN:VCARD)

#split in blocks per contact
@file = split $splitter, (join "\n", @file);

#remove the ones without bday and clean up
@file = grep {s/^\s*(.*?)\s*BDAY:([-\d]+)\S*\s*(.*)\s*$/$2_$1$3/} @file;
map {s/N://} @file;
#map {s/;+\s*$//} @file;
map {s/\r//g} @file;
map {s/;/&/} @file; #first ; -> &
map {s/;+/ /g} @file; #last off
map {s/\s+/ /g} @file;
map {s/ $//g} @file;

#remove bad lines (see a few lines further down)
grep {m/^(\d+)-(\d+)-(\d+)_([^&]+)&?(.*?)$/} @file;

#Result:
#1988-01-16_Menke&Mirja
return @file;
}


sub readThunderbirdCSVExport {
my $addressbook = shift;
#Result:
#1981-01-12_Menke&Torben
my ($file, @file);
my $bdaycolumn = 32-1;

#read file;
open INPUT , '<', $addressbook or die "Can't Open file, because $!";
#binmode INPUT, ":utf8";
#binmode(INPUT, ':encoding(iso-8859-15)');
@file = <INPUT>;
close INPUT;
shift @file; #removes first line (first splitter)

# remove lines without bdays
@file = grep {m/(\d+)\.(\d+)\.(\d+)/} @file;

foreach my $contact (@file) {
my @items = split ',', $contact;
my ($fn, $ln, $bday) = ('','','');

$fn = $items[0];
$ln = $items[1];
if ($items[$bdaycolumn] =~ m/(\d+)\.(\d+)\.(\d+)/) {
$bday = "$3-$2-$1";
} else {
$contact = 'WECH!';
}

if ($contact ne 'WECH!' and $ln ne '' and $fn ne '' and $bday ne '') {
$contact = $bday."_".$ln."&".$fn;
} else {
$contact = 'WECH!';
print "$fn $ln ($bday) macht Probleme\n" ;
}
}

@file = grep {!/^WECH!$/} @file;
return @file;
}


sub calcAge {
#format the blocks to nice looking lines:
#before: 1988-01-16_Mirja&Menke
#after: 07-01-16 Mirja Menke (19)
# sorts by bday
my @file = @_;
foreach (@file) {
# 19 88 - 01 - 16 _ Menke;Mirja
m/^(\d+)-(\d+)-(\d+)_([^&]+)&?(.*?)$/;
my $age = $today_year - $1;
$str = "-$2-$3 $5 $4";

if ($2 > $today_mon || ($2==$today_mon && $3 >= $today_mday)){
$_ = $today_year;
} else {
$_ = $today_year + 1;
$age++;
}
#take only the last 2 numbers of the year (Modulo 100)
$_ %= 100;
#ensure to have a 2 digits string
$_ = $_ < 10 ? "0$_" : "$_";

$_ .= $str;
($age ne '') and ($_ .= " ($age)");
}
#now: 06-01-12 Torben Menke (25)
@file = sort @file;
return @file;
}

sub calcdays {
my $line = shift;
# $line = '07-05-28 Torben Menke (25)';
unless ($line =~ m/(\d+)-(\d+)-(\d+)/) {
return -1;
}
my ($y,$m,$d) = ($1+2000-1900,$2-1,$3);
my $time = timelocal(0, 0, 0, $d, $m, $y);
return (( $time - $timetoday) /3600/24);
}


sub convert {
$_ = shift;
s/\d+-(\d+)-(\d+)/$2.$1./;
return $_;
}

sub printListPeople {
my @file = @_;
my $i = 0;
while ($i<$pastpeople){
$_ = $#file - $pastpeople + $i + 1;
$_ = &convert($file[$_]);
# age = age-1 if bday is in the past
$_ =~ m/^(.+)\((\d+)\)$/;
$_ = $1.'('.($2-1).')';
print $_;
print "\n";
$i++;
}
print " -=- today: $today_mday.$today_mon.$today_year -=- \n";
$i = 0;
while ($i<$futurepeople && $i <= $#file){
# print $file[$i]."\n";
print &convert($file[$i]);
print "\n";
$i++;
}
}

sub printListDays {
my @upcomingbdays = @_;
#substract 1 from year of next bday
my @lastbdays = @upcomingbdays;
@lastbdays = map {
# next bday -1 year : 07-07-27 -> 6-07-27
s/^(\d+)/$1-1/e; # year number is now 1 digit in some cases
# next age -1 year (23)-> 22
s/\((\d+)\)$/$1-1/e;
# add ( )
s/(\d+)$/($1)/;
$_ }
@lastbdays;

#filter out the ones in the gives day range
@lastbdays = grep {calcdays($_) > -$pastdays } @lastbdays;
@upcomingbdays = grep {calcdays($_) < $futuredays} @upcomingbdays;
foreach (@lastbdays) {
print convert ($_)."\n";
}
print " -=- today: $today_mday.$today_mon.$today_year -=- \n";
foreach (@upcomingbdays) {
print convert ($_)."\n";
}
}


sub genOutputFile () {
#uncomment to generate a birthday-database
my $out = join "\n",@contactlist;
open OUT, '>', 'output.txt' or die "Can't Open file, because $!";
#binmode OUTPUT, ":encoding($character)";
print OUT join "",$out;
close OUT;
}

@contactlist = ();
@contactlist = (@contactlist, readKDEvcf('/home/torben/.kde/share/apps/kabc/privat.vcf'));
@contactlist = (@contactlist, readKDEvcf('/home/torben/.kde/share/apps/kabc/iapp.vcf'));
#@contactlist = (@contactlist, readThunderbirdCSVExport('/home/torben/files/adressen/ap-h.csv'));

#@contactlist = (@contactlist, readKDEvcf('std.vcf'));
#@contactlist = (@contactlist, readThunderbirdCSVExport('ap-h.csv'));
#@contactlist = (@contactlist, readThunderbirdCSVExport('ap-w.csv'));
#@contactlist = (@contactlist, readThunderbirdCSVExport('ap-n.csv'));

# remove double ones
undef my %seen;
@contactlist = grep(!$seen{$_}++, @contactlist);

@contactlist = calcAge(@contactlist);
#print Dumper @contactlist;
printListDays(@contactlist);
#printListPeople(@contactlist);










# $_ = <STDIN>;

---

Hope you found what you where looking for. Feel free to drop me a line
Torben