cff22b28ae
It's possible this cleanup code is causing serious problems during failures, because it's leaving us no ics files when the export fails. Probably it would be better if we move aside the ics files and restore them later.
589 lines
21 KiB
Perl
Executable file
589 lines
21 KiB
Perl
Executable file
#!/usr/bin/perl -w
|
|
# calendar-export.plx -*- Perl -*-
|
|
|
|
# NOTE: Overall license of this file is GPLv3-only, due (in part) to Software
|
|
# Freedom Law Center copyrights (see below). Kuhn's personal copyrights are
|
|
# licensed GPLv3-or-later.
|
|
|
|
# ====================================================================
|
|
# The sub's "safe_read_from_pipe" and read_from_process are:
|
|
# Copyright (c) 2000-2004 CollabNet. All rights reserved.
|
|
#
|
|
# This software is licensed as described in the file COPYING, which
|
|
# you should have received as part of this distribution. The terms
|
|
# are also available at http://subversion.tigris.org/license-1.html.
|
|
# If newer versions of this license are posted there, you may use a
|
|
# newer version instead, at your option.
|
|
#
|
|
# This software consists of voluntary contributions made by many
|
|
# individuals. For exact contribution history, see the revision
|
|
# history and logs, available at http://subversion.tigris.org/.
|
|
|
|
|
|
# Note: bkuhn downloaded the license from
|
|
# http://subversion.tigris.org/license-1.html on 2013-12-29 which said:
|
|
|
|
# The license of Subversion 1.7 and later is at
|
|
# http://svn.apache.org/repos/asf/subversion/trunk/LICENSE.
|
|
|
|
# The license of Subversion 1.6 and earlier can be found at
|
|
# http://svn.apache.org/repos/asf/subversion/tags/1.6.0/www/license-1.html.
|
|
|
|
# Both license texts are now included, in APACHE-LICENSE and OLD-SVN-LICENSE,
|
|
# respectively.
|
|
# ====================================================================
|
|
#
|
|
|
|
# Copyright © 2013 Bradley M. Kuhn <bkuhn@ebb.org>
|
|
#
|
|
# This software's license gives you freedom; you can copy, convey,
|
|
# propogate, redistribute and/or modify this program under the terms of
|
|
# the GNU General Public License (GPL) as published by the Free
|
|
# Software Foundation (FSF), either version 3 of the License, or (at your
|
|
# option) any later version of the GPL published by the FSF.
|
|
#
|
|
# 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 in a file in the toplevel directory called
|
|
# "GPLv3". If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
# ====================================================================
|
|
# The functions DoLog, BinarySearchForTZEntry, PrivatizeMergeAndTZIcalFile,
|
|
# BuildTZList, MergeLists, PrivacyFilterICalFiles, and FilterEmacsToICal material
|
|
# copyrighted and licensed as below:
|
|
|
|
# Copyright © 2006 Software Freedom Law Center, Inc.
|
|
#
|
|
# This software gives you freedom; it is licensed to you under version 3
|
|
# of the GNU General Public License.
|
|
#
|
|
# This software is distributed WITHOUT ANY WARRANTY, without even the
|
|
# implied warranties of MERCHANTABILITY and FITNESS FOR A PARTICULAR
|
|
# PURPOSE. See the GNU General Public License for further details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License,
|
|
# version 3. If not, see <http://www.gnu.org/licenses/>
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use POSIX ":sys_wait_h";
|
|
use Fcntl; # for sysopen
|
|
use Carp;
|
|
use Data::ICal;
|
|
use File::Temp qw/:POSIX tempfile/;
|
|
use DateTime::TimeZone;
|
|
use Date::Manip;
|
|
use DateTime::Format::ICal;
|
|
|
|
my($CONFIG_FILE) = (@ARGV);
|
|
|
|
if (@ARGV != 1) {
|
|
print STDERR "usage: $0 <CONFIG_FILE>\n";
|
|
exit 1;
|
|
}
|
|
###############################################################################
|
|
my $CALENDAR_LOCK_FILE = "$ENV{HOME}/.emacs-calendar-to-ics-lock";
|
|
|
|
my $LOCK_CLEANUP_CODE = sub {
|
|
return (unlink($CALENDAR_LOCK_FILE) != 1) ?
|
|
"Failed unlink of $CALENDAR_LOCK_FILE. Could cause trouble." :
|
|
"";
|
|
};
|
|
###############################################################################
|
|
{
|
|
my %messageHistory;
|
|
|
|
sub DoLog ($$$;$) {
|
|
my($type, $user, $message, $cleanupCode) = @_;
|
|
|
|
use Date::Manip;
|
|
my $NOW = ParseDate("now");
|
|
|
|
my $lastTime = $messageHistory{$message};
|
|
|
|
my $sendIt = 0;
|
|
if (not defined $lastTime) {
|
|
$sendIt = 1;
|
|
} else {
|
|
my $err;
|
|
my $sinceLast = DateCalc($lastTime,"+ 10 minutes",\$err);
|
|
$sendIt = 1 if ($NOW gt $sinceLast);
|
|
}
|
|
if ($sendIt) {
|
|
my $fh = File::Temp->new();
|
|
$fh->unlink_on_destroy( 1 );
|
|
my $fname = $fh->filename;
|
|
print $fh "Calendar Export Failure: $message\n";
|
|
$fh->close();
|
|
system('/home/bkuhn/bin/myosd', $fname);
|
|
unless (-f "$ENV{HOME}/.silent-running") {
|
|
open(ESPEAK, "-|", "/usr/bin/espeak", '-p', '45', '-s', '130', '-f', $fname, "--stdout");
|
|
open(PAPLAY, "|-", "/usr/bin/paplay");
|
|
my $data;
|
|
while (read(ESPEAK, $data, 8) == 8) {
|
|
print PAPLAY $data;
|
|
}
|
|
close PAPLAY; close ESPEAK;
|
|
}
|
|
system('/usr/bin/notify-send', '-u', 'critical', '-t', '300000',
|
|
'Failure', "Calendar export failure: $message");
|
|
$messageHistory{$message} = $NOW;
|
|
}
|
|
my $more;
|
|
$more = &$cleanupCode if defined $cleanupCode and ref $cleanupCode;
|
|
$message .= " $more" if (defined $more and $more !~ /^\s*$/);
|
|
croak $message if $type eq "die";
|
|
warn $message;
|
|
}
|
|
sub DieLog ($;$) {
|
|
DoLog("die", undef, $_[0], $_[1]);
|
|
}
|
|
sub WarnLog ($$) {
|
|
DoLog("warn", $_[0], $_[1]);
|
|
}
|
|
}
|
|
###############################################################################
|
|
# Start a child process safely without using /bin/sh.
|
|
sub safe_read_from_pipe
|
|
{
|
|
unless (@_)
|
|
{
|
|
DieLog("$0: safe_read_from_pipe passed no arguments.");
|
|
}
|
|
|
|
my $pid = open(SAFE_READ, '-|');
|
|
unless (defined $pid)
|
|
{
|
|
DieLog("$0: cannot fork: $!");
|
|
}
|
|
unless ($pid)
|
|
{
|
|
open(STDERR, ">&STDOUT")
|
|
or DieLog("$0: cannot dup STDOUT: $!");
|
|
exec(@_)
|
|
or DieLog("$0: cannot exec `@_': $!\n");
|
|
}
|
|
my @output;
|
|
while (<SAFE_READ>)
|
|
{
|
|
s/[\r\n]+$//;
|
|
push(@output, $_);
|
|
}
|
|
close(SAFE_READ);
|
|
my $result = $?;
|
|
my $exit = $result >> 8;
|
|
my $signal = $result & 127;
|
|
my $cd = $result & 128 ? "with core dump" : "";
|
|
if ($signal or $cd)
|
|
{
|
|
DieLog("$0: pipe from `@_' failed $cd: exit=$exit signal=$signal\n");
|
|
}
|
|
if (wantarray)
|
|
{
|
|
return ($result, @output);
|
|
}
|
|
else
|
|
{
|
|
return $result;
|
|
}
|
|
}
|
|
###############################################################################
|
|
# Use safe_read_from_pipe to start a child process safely and return
|
|
# the output if it succeeded or an error message followed by the output
|
|
# if it failed.
|
|
sub read_from_process
|
|
{
|
|
unless (@_)
|
|
{
|
|
DieLog("$0: read_from_process passed no arguments.");
|
|
}
|
|
my ($status, @output) = &safe_read_from_pipe(@_);
|
|
if ($status)
|
|
{
|
|
return ("$0: `@_' failed with this output:", @output);
|
|
}
|
|
else
|
|
{
|
|
return @output;
|
|
}
|
|
}
|
|
###############################################################################
|
|
sub BinarySearchForTZEntry {
|
|
# $tzList is assumed to be sorted, $dateTime is
|
|
my($tzList, $dateTime) = @_;
|
|
my ($l, $u) = (0, @$tzList - 1); # lower, upper end of search interval
|
|
my $i; # index of probe
|
|
my $final = 0;
|
|
while ($l <= $u) {
|
|
$i = int(($l + $u)/2);
|
|
my $compareVal = DateTime->compare($tzList->[$i]{date}, $dateTime);
|
|
if ($compareVal < 0) {
|
|
$l = $i+1;
|
|
$final = $i;
|
|
} elsif ($compareVal > 0) {
|
|
$u = $i-1;
|
|
} else {
|
|
return $tzList->[$i]; # found, won't happen often
|
|
}
|
|
}
|
|
return $tzList->[$final]; # not found, go down one lower
|
|
}
|
|
###############################################################################
|
|
# Take a list of keys and a list of values and insersperse them and
|
|
# return the result
|
|
sub MergeLists {
|
|
my ($keys, $values) = @_;
|
|
DieLog("Length mismatch", $LOCK_CLEANUP_CODE) unless @$keys == @$values;
|
|
# Add the argument names to the values
|
|
my @result;
|
|
for (my $i = 0; $i < @$keys; $i++) {
|
|
push @result, $keys->[$i] => $values->[$i];
|
|
}
|
|
return @result;
|
|
}
|
|
###############################################################################
|
|
sub BuildTZList ($$$) {
|
|
my($user, $pubEmacsFile, $privEmacsFile) = @_;
|
|
|
|
my @tzList;
|
|
|
|
foreach my $file ($pubEmacsFile, $privEmacsFile) {
|
|
open(DATA, "<$file") or DieLog("unable to read $file: $!",
|
|
$LOCK_CLEANUP_CODE);
|
|
while (my $line = <DATA>) {
|
|
if ($line =~ /^\s*;[;\s]*TZ\s*=([^\s,]+)\s*(?:,+\s*LOCA?T?I?O?N?\s*=\"([^"]+)\")?
|
|
\s+(?:at|on)\s*(.*)\s+in\s+(\S+)\s*$/ix) {
|
|
my($newTZstr, $location, $dateStartStr, $dateStartTZstr) = ($1, $2, $3, $4);
|
|
my $newTZ;
|
|
eval { $newTZ = DateTime::TimeZone->new( name => $newTZstr ); };
|
|
if ($@ or not defined $newTZ) {
|
|
WarnLog($user,
|
|
"Invalid time zone of \"$newTZstr\" in $line from $file: $@");
|
|
next;
|
|
}
|
|
my $dateStartTZ;
|
|
eval {
|
|
$dateStartTZ = DateTime::TimeZone->new( name => $dateStartTZstr ); };
|
|
if ($@ or not defined $dateStartTZ) {
|
|
WarnLog($user,
|
|
"Invalid time zone of \"$dateStartTZstr\" in $line from $file: $@");
|
|
next;
|
|
}
|
|
my(@data) = UnixDate("$dateStartStr", qw(%Y %m %d %H %M %S));
|
|
if (@data != 6) {
|
|
WarnLog($user, "Unparseable date string of \"$dateStartStr\"" .
|
|
"in $line from $file");
|
|
next;
|
|
}
|
|
my @args = MergeLists([qw( year month day hour minute second)], \@data);
|
|
my $startDate;
|
|
eval {
|
|
$startDate = DateTime->new(@args, time_zone => $dateStartTZstr);
|
|
};
|
|
if ($@ or not defined $startDate) {
|
|
WarnLog($user, "Trouble parsing \"$dateStartStr $dateStartTZstr\" " .
|
|
"in $line from $file\n\n" .
|
|
"Most likely $dateStartTZstr was a bad time zone.: $@ ");
|
|
next;
|
|
}
|
|
push(@tzList, { date => $startDate, newTZ => $newTZ, location => $location});
|
|
}
|
|
}
|
|
}
|
|
# If we found nothing, everything is NYC
|
|
if (@tzList == 0) {
|
|
push(@tzList, { date => DateTime->new(year => 2006, month => 11, day => 03,
|
|
hour => 11, minute => 00, second => 00,
|
|
time_zone => "America/New_York"),
|
|
newTZ => "America/New_York", location => undef });
|
|
|
|
}
|
|
return sort { DateTime->compare($a->{date}, $b->{date}); } @tzList;
|
|
}
|
|
###############################################################################
|
|
sub FilterEmacsToICal ($$$$$) {
|
|
my ($publicCalendarFile, $privateCalendarFile, $outputDir,
|
|
$emacsSettings, $user) = @_;
|
|
|
|
my @tzList = BuildTZList($emacsSettings->{reportProblems},
|
|
$publicCalendarFile, $privateCalendarFile);
|
|
|
|
my($elispFH, $elispFile) = tempfile();
|
|
my $icsWillBePrivatizedFile = tmpnam();
|
|
my $icsPublicFile = tmpnam();
|
|
print $elispFH "(setq-default european-calendar-style t)\n"
|
|
if $emacsSettings->{calendarStyle} =~ /european/i;
|
|
print $elispFH <<ELISP_END
|
|
(setq icalendar-uid-format "emacs-%u-%h-%s")
|
|
ELISP_END
|
|
;
|
|
print $elispFH "(icalendar-export-file \"$privateCalendarFile\" \"$icsWillBePrivatizedFile\")\n"
|
|
if defined $privateCalendarFile;
|
|
print $elispFH "(icalendar-export-file \"$publicCalendarFile\" \"$icsPublicFile\")\n"
|
|
if defined $publicCalendarFile;
|
|
|
|
$elispFH->close();
|
|
my @emacsOutput = read_from_process($emacsSettings->{emacsBinary}, '--no-windows',
|
|
'--batch', '--no-site-file', '-l', $elispFile);
|
|
DieLog("Emacs process for exporting $privateCalendarFile and " .
|
|
"$publicCalendarFile exited with non-zero exit status of " .
|
|
"$? ($!), and output of:\n " . join("\n ", @emacsOutput),
|
|
$LOCK_CLEANUP_CODE)
|
|
if ($? != 0);
|
|
my $goodCount =0;
|
|
foreach my $line (@emacsOutput) {
|
|
$goodCount++
|
|
if $line =~ /^\s*Wrote\s+($icsPublicFile|$icsWillBePrivatizedFile)\s*$/;
|
|
}
|
|
DieLog("Unexpected Emacs output: " . join("\n ", @emacsOutput),
|
|
$LOCK_CLEANUP_CODE)
|
|
if ($goodCount > 2);
|
|
|
|
PrivatizeMergeAndTZIcalFile($icsWillBePrivatizedFile, $icsPublicFile,
|
|
$outputDir, \@tzList, $user);
|
|
|
|
PrivacyFilterICalFile($outputDir) if $emacsSettings->{privacyScrub};
|
|
DieLog("Unable to remove temporary files", $LOCK_CLEANUP_CODE)
|
|
unless unlink($icsPublicFile, $icsWillBePrivatizedFile) == 2;
|
|
}
|
|
###############################################################################
|
|
sub PrivacyFilterICalFiles ($$) {
|
|
my($icsDirectory) = @_;
|
|
|
|
chdir $icsDirectory or die "unable to change to $icsDirectory: $!";
|
|
|
|
foreach my $file (<*.ics>) {
|
|
my $newCalendar = Data::ICal->new(data => <<END_ICAL
|
|
BEGIN:VCALENDAR
|
|
VERSION:2.0
|
|
PRODID:-//Emacs//NONSGML icalendar.el//EN
|
|
END:VCALENDAR
|
|
END_ICAL
|
|
);
|
|
my $oldCalendar = Data::ICal->new(filename => $file);
|
|
my $entries = (defined $oldCalendar) ? $oldCalendar->entries : [];
|
|
my $x =0;
|
|
foreach my $entry (@{$entries}) {
|
|
my @newSubEntries;
|
|
foreach my $subEntry (@{$entry->{entries}}) {
|
|
my $refVal = ref $subEntry;
|
|
if (defined $refVal and $refVal =~ /Alarm/i) {
|
|
# Don't put it in the list in the public version if is an alarm
|
|
} else {
|
|
push(@newSubEntries, $subEntry);
|
|
}
|
|
}
|
|
$entry->{entries} = \@newSubEntries;
|
|
|
|
my $classes = $entry->property('class');
|
|
my $class;
|
|
foreach my $classProp (@{$classes}) {
|
|
$class = $classProp->value;
|
|
last if defined $class and
|
|
$class =~ /^\s*(?:PUBLIC|PRIVATE|CONFIDENTIAL)\s*/i;
|
|
}
|
|
if (defined $class and $class =~ /CONFIDENTIAL/i) {
|
|
foreach my $prop (qw/location summary description/) {
|
|
my $propList = $entry->property($prop);
|
|
$entry->add_property($prop => "Private")
|
|
if (defined $propList and @{$propList} > 0);
|
|
}
|
|
} elsif (defined $class and $class =~ /PRIVATE/i){
|
|
# do not put this event in the output at all
|
|
die "unable to scrub $file in $icsDirectory: $!"
|
|
unless unlink($file) == 1;
|
|
}
|
|
$newCalendar->add_entry($entry);
|
|
}
|
|
open(SCRUBBED_CAL, ">$file") or
|
|
DieLog("Unable to overwrite $file: $!", $LOCK_CLEANUP_CODE);
|
|
print SCRUBBED_CAL $newCalendar->as_string;
|
|
close SCRUBBED_CAL;
|
|
DieLog("Error when writing $file: $!", $LOCK_CLEANUP_CODE)
|
|
unless $? == 0;
|
|
undef $newCalendar;
|
|
}
|
|
}
|
|
######################################################################
|
|
sub PrivatizeMergeAndTZIcalFile ($$$$$$) {
|
|
my($icsPrivate, $icsPublic, $icsOutputDir, $tzList, $user, $errorUser) = @_;
|
|
|
|
my %calendar;
|
|
$calendar{private} = Data::ICal->new(filename => $icsPrivate);
|
|
$calendar{public} = Data::ICal->new(filename => $icsPublic);
|
|
my $type = "public";
|
|
foreach my $type (qw/public private/) {
|
|
my $entries = (defined $calendar{$type}) ? $calendar{$type}->entries : [];
|
|
foreach my $entry (@{$entries}) {
|
|
my $newCalendar = Data::ICal->new(data => <<END_ICAL
|
|
BEGIN:VCALENDAR
|
|
VERSION:2.0
|
|
PRODID:-//Emacs//NONSGML icalendar.el//EN
|
|
END:VCALENDAR
|
|
END_ICAL
|
|
);
|
|
$entry->add_property(class => "CONFIDENTIAL") if ($type eq "private");
|
|
|
|
# Let's shift some timezones around.
|
|
foreach my $dateType (qw/DTSTART DTEND/) {
|
|
my $datePropList = $entry->property($dateType);
|
|
next unless @$datePropList > 0;
|
|
|
|
WarnLog($errorUser, "Strange that the entry below for $icsOutputDir had more " .
|
|
"than one $dateType:\n" . Data::Dumper->Dumper($entry) )
|
|
unless @$datePropList == 1;
|
|
|
|
my $dateProp = $datePropList->[0];
|
|
# Only continue processing date if we have this property. (Duh)
|
|
next unless defined $dateProp;
|
|
my $params = $dateProp->parameters();
|
|
|
|
# Only continue if it is a DATE-TIME property. This is a bit of a
|
|
# judgement call but I think it's the right one. When someone
|
|
# creates an all-day event, we don't want to allow it to drift to
|
|
# antoher day merely because the user has moved time zones.
|
|
|
|
next unless defined $params and defined $params->{VALUE}
|
|
and $params->{VALUE} =~ /DATE\-TIME/i;
|
|
my $nyTime = DateTime::Format::ICal->parse_datetime($dateProp->value);
|
|
my $newDate = DateTime::Format::ICal->parse_datetime($dateProp->value);
|
|
$nyTime->set_time_zone("America/New_York")
|
|
if $nyTime->time_zone->name =~ /floating/;
|
|
my $val = BinarySearchForTZEntry($tzList, $nyTime);
|
|
$newDate->set_time_zone($val->{newTZ});
|
|
$newDate->set_time_zone("America/New_York");
|
|
$newDate->set_time_zone("floating");
|
|
my $newICalDate = DateTime::Format::ICal->format_datetime($newDate);
|
|
$dateProp->value($newICalDate);
|
|
|
|
}
|
|
$newCalendar->add_entry($entry);
|
|
|
|
# Now, write out each event into a single ics file in $icsOutputDir.
|
|
# This will overwrite existing events of the same name.
|
|
|
|
my $uidList = $entry->property('UID');
|
|
DieLog("This entry has multiple UIDs: @{$uidList}", $LOCK_CLEANUP_CODE)
|
|
unless @$uidList == 1;
|
|
my $uid = $uidList->[0]->value;
|
|
|
|
my $outputFile = File::Spec->catpath("", $icsOutputDir, "${uid}.ics");
|
|
open(SINGLE_EVENT_ICAL, ">", $outputFile) or
|
|
DieLog("Unable to overwrite $outputFile: $!", $LOCK_CLEANUP_CODE);
|
|
print SINGLE_EVENT_ICAL $newCalendar->as_string;
|
|
close SINGLE_EVENT_ICAL;
|
|
DieLog("Error ($?) while writing $outputFile ($?): $!", $LOCK_CLEANUP_CODE) unless $? == 0;
|
|
undef $newCalendar;
|
|
}
|
|
}
|
|
|
|
# Create specialized "Time Zone change" events to indicate the user's travel.
|
|
foreach my $tzEntry (@$tzList) { $tzEntry->{date}->set_time_zone("floating"); }
|
|
for (my $ii = 0; $ii < @$tzList; $ii++) {
|
|
my $tzEntry = $tzList->[$ii];
|
|
|
|
next unless defined $tzEntry->{location} and
|
|
$tzEntry->{location} !~ /^\s*NYC\s*$/i;
|
|
|
|
my $startDate = DateTime::Format::ICal->format_datetime($tzEntry->{date});
|
|
|
|
|
|
my $nextDate = ($ii+1 < @$tzList) ?
|
|
DateTime::Format::ICal->format_datetime($tzList->[$ii+1]{date}) : $startDate;
|
|
|
|
$nextDate =~ s/T\d+Z?$//; $startDate =~ s/T\d+Z?$//;
|
|
|
|
my $whereEvent = Data::ICal::Entry::Event->new();
|
|
my $desc = "$user Travel: ". $tzEntry->{location};
|
|
my $uid = "bkuhnScript" . '-' . sha1($desc . $startDate);
|
|
$whereEvent->add_properties(summary => "$user Travel: ". $tzEntry->{location},
|
|
description => $tzEntry->{location},
|
|
dtstart => [ $startDate, { VALUE => 'DATE' } ],
|
|
dtend => [ $nextDate,{ VALUE => 'DATE' } ],
|
|
uid => $uid);
|
|
my $newCalendar = Data::ICal->new(data => <<END_ICAL
|
|
BEGIN:VCALENDAR
|
|
VERSION:2.0
|
|
PRODID:-//Emacs//NONSGML icalendar.el//EN
|
|
END:VCALENDAR
|
|
END_ICAL
|
|
);
|
|
$newCalendar->add_entry($whereEvent);
|
|
|
|
my $outputFile = File::Spec->catpath("", $icsOutputDir, "${uid}.ics");
|
|
open(SINGLE_EVENT_ICAL, ">", $outputFile) or
|
|
DieLog("Unable to overwrite $outputFile: $!", $LOCK_CLEANUP_CODE);
|
|
print SINGLE_EVENT_ICAL $newCalendar->as_string;
|
|
close SINGLE_EVENT_ICAL;
|
|
DieLog("Error ($?) while writing $outputFile ($?): $!", $LOCK_CLEANUP_CODE) unless $? == 0;
|
|
undef $newCalendar;
|
|
}
|
|
return \%calendar;
|
|
}
|
|
######################################################################
|
|
sub ReadConfig($) {
|
|
my($configFile) = @_;
|
|
open (CONFIG_FILE, "<", $configFile) or DieLog("unable to read $configFile ($?): $!");
|
|
|
|
my %config;
|
|
|
|
while (my $line = <CONFIG_FILE>) {
|
|
chomp $line;
|
|
DieLog("Unable to parse $line in config file, $configFile",
|
|
$LOCK_CLEANUP_CODE)
|
|
unless $line =~ /^\s*([^:]+)\s*:\s*([^:]+)\s*$/;
|
|
$config{$1} = $2;
|
|
}
|
|
close CONFIG_FILE; DieLog("Error reading $configFile ($?): $!",
|
|
$LOCK_CLEANUP_CODE) if $? != 0;
|
|
return \%config;
|
|
}
|
|
######################################################################
|
|
system("/usr/bin/lockfile -r 8 $CALENDAR_LOCK_FILE");
|
|
unless ($? == 0) {
|
|
print "\${color5}Calendar export failure: Cannot aquire lock on $CALENDAR_LOCK_FILE\n";
|
|
exit 0;
|
|
}
|
|
if (not -r $CONFIG_FILE) {
|
|
print "\${color5}$CONFIG_FILE does not exist\n";
|
|
exit 0;
|
|
}
|
|
my $config = ReadConfig($CONFIG_FILE);
|
|
|
|
$config->{scrubPrivate} = 0 if not defined $config->{scrubPrivate};
|
|
$config->{reportProblems} = $config->{user} if not defined $config->{reportProblems};
|
|
$config->{emacsBinary} = "/usr/bin/emacs" if not defined $config->{emacsBinary};
|
|
$config->{calendarStyle} = 'plain' if not defined $config->{calendarStyle};
|
|
DieLog("$config->{emacsBinary} doesn't appear to be executable for $config->{emacsBinary}")
|
|
unless defined $config->{emacsBinary} and -x $config->{emacsBinary};
|
|
|
|
DieLog("$CONFIG_FILE doesn't specify a (readable) output directory via outputDir setting: $!")
|
|
unless defined $config->{outputDir} and -d $config->{outputDir};
|
|
|
|
if (defined $config->{cleanOutputDirFirst} and $config->{cleanOutputDirFirst}) {
|
|
chdir $config->{outputDir} or die "unable to change directory to $config->{outputDir} $? $!";
|
|
system("/bin/rm -f *.ics");
|
|
}
|
|
|
|
unless ((defined $config->{publicDiary} and -r $config->{publicDiary}) or
|
|
(defined $config->{privateyDiary} and -r $config->{privateDiary})) {
|
|
foreach my $key (qw/publicDiary privateDiary/) {
|
|
print "\${color5}$key file, $config->{$key} does not exist\n"
|
|
if defined $config->{$key}
|
|
}
|
|
exit 0;
|
|
}
|
|
FilterEmacsToICal($config->{publicDiary}, $config->{privateDiary},
|
|
$config->{outputDir}, $config, $config->{user});
|
|
|
|
&$LOCK_CLEANUP_CODE();
|
|
|
|
__END__
|
|
# Local variables:
|
|
# compile-command: "perl -c calendar-export.plx"
|
|
# End:
|