<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;"># Copyright 1999-2006, Fred Steinberg, Brown Bear Software

# Database.pm - non-implementation specific database stuff.
#
# Each Database object contains a DBImplementation object to handle the
# implementation specific things. (current implementations include:
# DBM, DB_Serialize)

# Warning: finagling was patched on to avoid leaking memory (which matters for
#          mod_perl/Apache::Registry type systems.)

# new
# name, description
# openDatabase, closeDatabase
# createDatabase, deleteDatabase, renameDatabase
# version
# description
# _getBaseFilename
# _getFilename
# setPreferencesToDefault
# setPreferences, getPreferences
# insertEvent
# _insertRegularEvent, _insertRepeatingEvent
# getEvent, getEvents
# deleteEvent
# deleteEventsInRange
# getApplicableEvents
# getEventDateHash
# getEventLists
# setPermission, getPermission
# getPermittedUsers, setPermittedUsers
# removeFromIncludeLists
# findEventsMatching
# findRepeatingEventsMatching
# getAllRegularEvents, getAllRepeatingEvents
# renameCategory

package Database;

use strict;
use Calendar::Date;
use Calendar::Defines;
use Calendar::Permissions;
use Calendar::Preferences;
use Calendar::AddIn;
use Fcntl;

my %imps = (Serialize   =&gt; 'DB_Serialize',
            DBM         =&gt; 'DB_DBM');

# Pass in the name of the database, and an optional Implementation to use.
# If no implementation specified, we get it from the Defines.

{
    # Cache Database objects - if we've already got one w/same name &amp; imp,
    # just return it.
    my %objCache;

sub new {
    my $class = shift;
    my ($dbName, $imp) = @_;

    # If IMP is special CNAME string, use that as the name for the cache.
    # Needed if this is an Add-In, can have mult. w/same name
    my $cache_name = $dbName;
    if ($imp &amp;&amp; $imp =~ /^CNAME (.+)/) {
        $cache_name = $1;
        undef $imp;
    }

    $imp ||= Defines-&gt;databaseType;
    die "Don't know how to do a $imp database!" unless $imps{$imp};

    return $objCache{$cache_name.$imp} if (defined $objCache{$cache_name.$imp});

    eval "require Calendar::$imps{$imp}";
    die "Couldn't find Calendar::$imps{$imp}" if $@;

    my $okName;
    unless ($dbName =~ /^(\w+)$/ and $okName = $1) { # untaint and check
        $dbName =~s/([^\w ])/uc sprintf("&amp;#%04d",ord($1))/eg;
        die "Bad Calendar or Database name! '$dbName' \n";
    }

    my $self = {};
    bless $self, $class;

    $self-&gt;{'name'}     = $okName;
    $self-&gt;{cache_name} = $cache_name;
    $self-&gt;{'Imp'}      = $imps{$imp}-&gt;new ($self);

    my $selfRef = \$self;
    bless $selfRef, $class;     # so we can avoid memory leak

    $objCache{$cache_name.$imp} = $selfRef;
    $selfRef;
}

sub clearCache {
    foreach my $ook (values %objCache) {
        $ook-&gt;closeDatabase (1);
    }
    %objCache = ();
}

sub END {
    foreach my $ook (values %objCache) {
        $ook-&gt;closeDatabase (1);
    }
}
}

sub DESTROY {
     my $self = shift;
     return unless ($self-&gt;isa ('REF')); # oh dear
     delete $$self-&gt;{Imp};       # all to patch leak from circular refs...oy
}

sub name {
    my $self = shift;
    $self = $$self if ($self-&gt;isa ('REF')); # oh dear (called from Imps)
    return $self-&gt;{'name'};
}

# Unique name; needed since any number of Add-Ins can have same name
sub cache_name {
    my $self = shift;
    $self = $$self if ($self-&gt;isa ('REF')); # oh dear (called from Imps)
    return $self-&gt;{'cache_name'};
}

# Optionally pass version string to set it
sub version {
    my $self = shift;
    my $version = shift;
    $self = $$self if ($self-&gt;isa ('REF')); # oh my
    $self-&gt;{'Imp'}-&gt;setVersion ($version) if $version;
    $self-&gt;{'Imp'}-&gt;getVersion ();
}

sub description {
    my $self = shift;
    my $description = shift;

    if (defined $description) {
        $self-&gt;setPreferences ({Description =&gt; $description});
    } else {
        $description = $self-&gt;getPreferences ('Description') || '';
    }

    return $description;
}

# Pass readwrite flag
sub openDatabase {
    my $self = shift;
    $self = $$self if ($self-&gt;isa ('REF')); # oh dear

    my $readWrite = $_[0];
    if ($readWrite =~ /^(rw|rdwr|o_rdwr)$|write/i and
        !$self-&gt;isSyncing                         and
        $self-&gt;isLockedForSync) {
         require Calendar::GetHTML;
         GetHTML-&gt;errorPage (undef, # i18n
                             header    =&gt; 'Calendar `' . $self-&gt;name .
                                          "' is Locked",
                             message   =&gt; 'This Calendar is currently being ' .
                                          'Synchronized. Please try again ' .
                                          'in a few moments');
         warn "Error: Sync in progress on " . $self-&gt;name . "\n";
         die "\n";
     }

    $self-&gt;{'Imp'}-&gt;openDatabase (@_);
}

sub closeDatabase {
    my $self = shift;
    $self = $$self if ($self-&gt;isa ('REF')); # gosh
    $self-&gt;{'Imp'}-&gt;closeDatabase (@_);
}

# Delete a database altogether, i.e. remove it's data files or purge its DB
# tables
sub deleteDatabase {
    my $self = shift;
    $$self-&gt;{'Imp'}-&gt;deleteDatabase (@_);
}

sub renameDatabase {
    my ($self, $newName) = @_;
    return unless $newName =~ /^(\w+)$/;     # untaint and check it
    $newName = $1;
    $$self-&gt;{'Imp'}-&gt;renameDatabase ($newName);
    1;
}

# Pass an arg if you want to overwrite an existing db of the same name.
# This is used when a new Database object has been created but the database
# itself does not yet exist.
sub createDatabase {
    my $self = shift;
    $self = $$self if ($self-&gt;isa ('REF'));
    $self-&gt;{'Imp'}-&gt;createDatabase (@_);

    $self-&gt;version (Defines-&gt;version);

    # default permission is 'anybody can do anything' (!?)
    my $perm = Permissions-&gt;new ($self);
    $perm-&gt;setAnonymous ('Admin');
}

# Return full path of datafile name, sans extension, (DBImplementation adds
# it) Derived classes override this to put files in weird places. Unused
# for real database implementations.
sub _getBaseFilename {
    my $self = shift;
    $self = $$self if ($self-&gt;isa ('REF'));
    return Defines-&gt;baseDirectory . "/data/$self-&gt;{'name'}";
}

# Return full path of datafile name
sub _getFilename {
    my $self = shift;
    $self = $$self if ($self-&gt;isa ('REF'));
    $self-&gt;{'Imp'}-&gt;_getFilename;
}

sub setPreferencesToDefault {
    my $self = shift;
    my $db = shift;
    my $prefs = ($db &amp;&amp; $db-&gt;isa ('Database')) ? Preferences-&gt;new ($db)
                                               : Preferences-&gt;new ();
    # Title defaults to calendar name
    $prefs-&gt;Title ($self-&gt;name);
    $self-&gt;setPreferences ($prefs);
}

# Set preferences, i.e. write to the database
# Pass a ref to a hash of key/value pairs, or a Preferences object
sub setPreferences {
    my $self = shift;
    $self = $$self if ($self-&gt;isa ('REF'));
    my ($argHash) = (@_);

    my $prefs;

    if (ref ($argHash) eq 'Preferences') {
        $prefs = $argHash;
    } else {
        $prefs = $self-&gt;{'Imp'}-&gt;getPreferences || Preferences-&gt;new;
        $prefs-&gt;setValues ($argHash);
    }
    $self-&gt;{'Imp'}-&gt;savePreferences ($prefs);
}

# If called w/no args, return the whole Prefs object.
# If called w/ 1 arg, return just the specified value.
sub getPreferences {
    my $self = shift;
    my $key = shift;

    my $prefs = $$self-&gt;{'Imp'}-&gt;getPreferences;

    return $prefs-&gt;{$key} if ($prefs &amp;&amp; $key);
    return $prefs;
}

# Insert an event. It can be regular or repeating.
sub insertEvent {
    my $self = shift;
    my ($event, $date) = @_;

    $event-&gt;id ($$self-&gt;{'Imp'}-&gt;nextID);

    if ($event-&gt;isRepeating()) {
        $self-&gt;_insertRepeatingEvent ($event);
    } else {
        $self-&gt;_insertRegularEvent ($date, $event);
    }

    # keep track for syncing, maybe
    if ($self-&gt;getPreferences ('IsSyncable') and
        $self-&gt;getPreferences ('LastRMSyncID')) {
        require Calendar::SyncInfo;
        SyncInfo-&gt;new ($self-&gt;name)-&gt;eventAdded ($event-&gt;id);
    }
}

# Delete event w/the specified id, and re-insert the new version
sub replaceEvent {
    my ($self, $event, $date, $noDelete) = @_;
    return unless defined $event-&gt;id;
    if (!defined $noDelete) {
        $self-&gt;deleteEvent ($date, $event-&gt;id, 'all', 'noSyncEntry');
    }
    if ($event-&gt;isRepeating()) {
        $self-&gt;_insertRepeatingEvent ($event);
    } else {
        $self-&gt;_insertRegularEvent ($date, $event);
    }

    # deleteEvent removes reminders; let's add them back.
    if (Defines-&gt;mailEnabled and $event-&gt;reminderTimes) {
        require Calendar::Mail::MailReminder;
        MailReminder-&gt;add ($event, $self-&gt;name, $date);
    }

    if ($self-&gt;getPreferences ('IsSyncable') and
        $self-&gt;getPreferences ('LastRMSyncID')) {
        require Calendar::SyncInfo;
        SyncInfo-&gt;new ($self-&gt;name)-&gt;eventModified ($event-&gt;id);
    }
}

# Pass list of events, which are all expected to be the same type!
# Return ref to new list of event objects (w/id set.)
# (used for compiling AddIns, bulk loading, TripleSync)
sub insertEvents {
    my $self = shift;
    my ($eventList) = @_;
    return $self-&gt;insertEvent ($eventList) unless (ref $eventList eq 'ARRAY');
    return unless @$eventList;

    my $imp = $self-&gt;isa ('REF') ? $$self-&gt;{Imp} : $self-&gt;{Imp};

    my $numEvents = @$eventList;
    $numEvents /= 2 unless ($eventList-&gt;[0]-&gt;isRepeating());     # gross
    my $nextID = $imp-&gt;reserveNextIDs ($numEvents);

    my $newEvents;

    if ($eventList-&gt;[0]-&gt;isRepeating()) {
        $newEvents = $imp-&gt;insertRepeatingEvents ($eventList, $nextID);
    } else {
        $newEvents = $imp-&gt;insertRegularEvents ($eventList, $nextID);
    }
    return $newEvents;
}

# Stick an event on the list for a certain date
sub _insertRegularEvent {
    my $self = shift;
    $$self-&gt;{'Imp'}-&gt;insertRegularEvent (@_);
}

sub _insertRepeatingEvent {
    my $self = shift;
    $$self-&gt;{'Imp'}-&gt;insertRepeatingEvent (@_);
}

# Return an event, identified by date and id.
# Repeating events don't have dates, just ids.
# Return undef if event not found
sub getEvent {
    my $self = shift;
    my ($date, $eventID) = @_;
    my $ev = $$self-&gt;{'Imp'}-&gt;getEvent ($date, $eventID);
    $ev-&gt;Prefs ($self-&gt;getPreferences) if $ev;
    return $ev;
}

# Return event and date; pass in only ID (i.e. no date)
# Return StartDate for repeating events
# Return nada if not found.
sub getEventById {
    my ($self, $id) = @_;
    my $repeats = $self-&gt;getAllRepeatingEvents (noPrefs =&gt; 1);
    foreach (@$repeats) {
        if ($_-&gt;id == $id) {
            $_-&gt;Prefs ($self-&gt;getPreferences);
            return ($_, $_-&gt;repeatInfo-&gt;startDate);
        }
    }

    my $regHash = $self-&gt;getAllRegularEvents (noPrefs =&gt; 1);
    foreach my $date (keys %$regHash) {
        foreach my $event (@{$regHash-&gt;{$date}}) {
            if ($event-&gt;id == $id) {
                $event-&gt;Prefs ($self-&gt;getPreferences);
                return ($event, $date);
            }
        }
    }
    return;
}

# Return a ref to a hash of regular events in the specified date range, and
# a ref to an array of ALL repeating events. (Unless the date range is
# bad.) Don't use a large date range, as DB implementations are not very
# smart...
sub getEvents {
    my $self = shift;
    my ($fromDate, $toDate) = @_;
    return if ($fromDate &gt; $toDate);
    my @ret;
    eval {
        @ret = $$self-&gt;{'Imp'}-&gt;getEvents ($fromDate, $toDate);
    };
    return @ret unless $@;
    warn "Problem with " . $self-&gt;name . ": $@";
    return ({}, [], 1);   # if DB error, return empty event lists and err flag
}

# Delete an event for a certain date. If the event isn't found for that
# date (or the date is undef), maybe it's a repeating event. The third
# param only applies for repeating events. And if there are mail reminders,
# delete them. Return deleted event text.
sub deleteEvent {
    my $self = shift;
    my ($date, $eventID, $allOrOne, $noSyncEntry) = @_;
    my $event = $self-&gt;getEvent ($date, $eventID);
    return undef unless $event;

    if (Defines-&gt;mailEnabled and $event and $event-&gt;reminderTimes) {
        my $justOne = ($allOrOne and ($allOrOne =~ /all/i ? undef : $date));
        require Calendar::Mail::MailReminder;
        MailReminder-&gt;deleteEventReminders ($eventID, $self-&gt;name, $justOne);
    }
    $$self-&gt;{'Imp'}-&gt;deleteEvent ($date, $eventID, $allOrOne);

    # keep track for syncing, maybe (not if we're doing a "replace", though)
    if (!$noSyncEntry and
        $self-&gt;getPreferences ('IsSyncable') and
        $self-&gt;getPreferences ('LastRMSyncID')) {
        require Calendar::SyncInfo;
        if ($allOrOne and $allOrOne !~ /all/i) {
            SyncInfo-&gt;new ($self-&gt;name)-&gt;eventModified ($eventID);
        } else {
            SyncInfo-&gt;new ($self-&gt;name)-&gt;eventDeleted ($eventID);
        }
    }

    return ($event &amp;&amp; $event-&gt;text);
}

# Delete all events in a specified date range. Repeating events will be
# deleted if their start and end specs are within the specified range.
# Don't forget about the MailReminders, too.
# Return ref to list of deleted ids
sub deleteEventsInRange {
    my $self = shift;
    my %args = (from       =&gt; undef,
                to         =&gt; undef,
                categories =&gt; undef,
                @_);
    my $fromDate   = $args{from};
    my $toDate     = $args{to};
    my $categories = $args{categories};

    return if ($fromDate &gt; $toDate);
    my $ids = $$self-&gt;{'Imp'}-&gt;deleteEventsInRange ($fromDate, $toDate,
                                                    $categories);
    if (Defines-&gt;mailEnabled) {
        require Calendar::Mail::MailReminder;
        MailReminder-&gt;deleteEventReminders ($ids, $self-&gt;name);
    }
    return $ids;
}

# Delete ALL events for the calendar. (Used for syncing.)
# Also resets last id.
sub deleteAllEvents {
    my $self = shift;
    $$self-&gt;{Imp}-&gt;deleteAllEvents;
    if (Defines-&gt;mailEnabled) {
        require Calendar::Mail::MailReminder;
        MailReminder-&gt;deleteAllForCalendar ($self-&gt;name);
    }
}

# Return a list of all (regular &amp; repeating) events which apply for a
# certain date. Due to timezone offsets, we may need to check previous and
# next day too. Also, events which start yesterday and extend into today
# can be returned.
#
# $flags specifies whether to not adjust event times ("noadjust") for
# timezone, and whether to get "yesterday"s events as well.
#
# So: EVENTS ARE ADJUSTED for TIMEZONE unless 'noadjust' passed in flags
sub getApplicableEvents {
    my $self = shift;
    my ($date, $prefs, $flags) = @_;

    $flags ||= '';
    my $noAdjust  = $flags =~ /noadjust/;
    my $yesterday = $flags =~ /yesterday/;

    my ($startDate, $endDate);
    my $offset = $noAdjust ? 0 : $prefs-&gt;Timezone || 0;
    if ($offset &lt; 0) {
        $startDate = $date;
        $endDate = $date + 1;
    } elsif ($offset &gt; 0) {
        $startDate = $date - 1;
        $endDate = $date;
    } else {
        $startDate = $endDate = $date;
    }

    # Events might start yesterday and extend into today
    if ($yesterday) {
        $startDate--;
    }

    my $hash = $self-&gt;getEventDateHash ($startDate, $endDate, $prefs,
                                        $noAdjust);

    my @theEvents = @{$hash-&gt;{"$date"} || []};

    # for repeating events, make sure Date is right
    # set Date for events; important for repeating events
    if (!$noAdjust) {
        foreach (@theEvents) {
            next unless $_-&gt;isRepeating;
            $_-&gt;Date ($date);
        }
    }

    # add events that start yesterday, but extend into today. (Need for
    # TimePlan, DayPlanner views, as well as conflict checking.)
    if ($yesterday) {
        my $yesterday = $date - 1;
        foreach (@{$hash-&gt;{"$yesterday"} || []}) {
            next unless ($_-&gt;endTime and $_-&gt;endTime &lt; $_-&gt;startTime);

            # save actual date it's on. If repeating, we need a copy! (In
            # case on both days.)
            my $copy = $_-&gt;copy;
            $copy-&gt;Date ($yesterday);
            push @theEvents, $copy;
        }
    }

    return @theEvents;
}

# Return a ref to a hash of lists of applicable events, keyed on dates.
# Pass in a from and to date, and prefs, and flag to not adjust for tz.
# We'll grab the single events from the Database, and ask each repeating
# event to fill the hash with its repeating fellows.
# Events included from other cals aren't included unless they should be.
# EVENTS ARE ADJUSTED for TIMEZONE unless 'noadjust' passed
sub getEventDateHash {
    my $self = shift;
    my ($fromDate, $toDate, $prefs, $noAdjust) = @_;

    my ($regs, $repeats) = $self-&gt;getEventLists ($prefs, $fromDate, $toDate);

    my $origTZ = $prefs-&gt;Timezone;
    $prefs-&gt;Timezone (0)        # TZ used to get skipweekends right in addto...
        if $noAdjust;

    foreach (@$repeats) {
        $_-&gt;addToDateHash ($regs, $fromDate, $toDate, $prefs);
    }

    $prefs-&gt;Timezone ($origTZ)
        if $noAdjust;

    return $regs if $noAdjust;

    my $offset = $prefs-&gt;Timezone;
    if (!$offset) {
        return $regs;
    }

    # Timezone Offset specified, adjust
    my %adjusted;
    while (my ($date, $list) = each %$regs) {
        foreach my $event (@$list) {
            my $dateObj = Date-&gt;new ($date);
            my $newDate;
            my $copy = $event-&gt;copy;
            # be careful, it may have already been adjusted
            if (defined $copy-&gt;TZoffset) {
                $newDate = $dateObj + $copy-&gt;TZoffset;
            } else {
                # we need to make a copy first, in case orig is cached
                $copy-&gt;adjustForTimezone ($dateObj, $offset);
                $newDate = $copy-&gt;Date;
            }
            $newDate = "$newDate";  # must stringify Date obj
            $adjusted{$newDate} ||= [];
            push @{$adjusted{$newDate}}, $copy;
        }
    }
    return \%adjusted;
}

# Return list of event instances, each with Date set
sub get_instances_in_range {
    my ($self, $from_date, $to_date, $prefs) = @_;
    my $hash = $self-&gt;getEventDateHash ($from_date, $to_date, $prefs);
    my @events;
    while (my ($date_string, $ev_list) = each %$hash) {
        my $date_obj = Date-&gt;new ($date_string);
        foreach my $event (@$ev_list) {
            my $copy = $event-&gt;copy;
            $copy-&gt;Date ($date_obj);
            push @events, $copy;
        }
    }
    return @events;
}


# Return a ref to a hash of lists of tentative events, keyed on dates.
# Repeating events are NOT EXPANDED; they're only added to the list for
# their start date. (But the start date is adjusted to be first date event
# actually occurs on.)
sub getTentativeEvents {
    my ($self) = @_;

    my $regHash = $self-&gt;getAllRegularEvents;
    my $repeats = $self-&gt;getAllRepeatingEvents;

    foreach my $date (keys %$regHash) {
        $regHash-&gt;{$date} = [grep {$_-&gt;isTentative} @{$regHash-&gt;{$date}}];
        delete $regHash-&gt;{$date} unless $regHash-&gt;{$date}-&gt;[0];
    }
    my $prefs;
    foreach (@$repeats) {
        next unless $_-&gt;isTentative;
        my $startDate = $_-&gt;repeatInfo-&gt;startDate;

        # need to find first date event actually occurs
        if (!$_-&gt;repeatInfo-&gt;applies ($startDate)) {
            $prefs ||= $self-&gt;getPreferences; # only get first time
            my $hash = $_-&gt;repeatInfo-&gt;nextNOccurrences ($_, 1, $startDate,
                                                         $prefs);
            my ($date) = keys %$hash;
            $startDate = $date || $startDate;
        }

        $startDate = "$startDate"; # in case it's a Date
        $regHash-&gt;{$startDate} ||= [];
        push @{$regHash-&gt;{$startDate}}, $_;
    }
    $regHash;
}

# Add tentative events from all included calendars user has 'Edit' perm in
# to existing eventHash ref
sub addIncludedTentativeEvents {
    my ($self, $userName, $eventHash) = @_;
    my $prefs = $self-&gt;getPreferences;
    my @includedNames = $prefs-&gt;getIncludedCalendarNames;
    foreach my $incName (@includedNames) {
        my $incDb = Database-&gt;new ($incName);
        next unless Permissions-&gt;new ($incDb)-&gt;permitted ($userName, 'Edit');
        my $thisHash = $incDb-&gt;getTentativeEvents;
        while (my ($date, $events) = each %$thisHash) {
            map {$_-&gt;includedFrom ($incName)} @$events;
            $eventHash-&gt;{$date} ||= [];
            push @{$eventHash-&gt;{$date}}, @$events;
        }
    }
}

# Return a hash of lists of regular events, keyed on date, and a list of
# repeating events. Pass 1 arg for a single day, or a from date and to date.
# Add-Ins are handled through the 'included calendar' stuff.
sub getEventLists {
    my $self = shift;
    my ($prefs, $fromDate, $toDate) = @_;

    $toDate = $fromDate unless $toDate;
    return (undef, undef) if ($fromDate &gt; $toDate);

    my (%regularEvents, @repeatingEvents);

    # Get events from each calendar we include, including ourselves.
    my @includeNames = $prefs-&gt;getIncludedCalendarNames;
    my @dbList       = map {Database-&gt;new ($_)} @includeNames;
    unshift @dbList, $self;

    # Keep track of which categories to include for each included calendar
    my $incInfo = $prefs-&gt;getIncludedCalendarInfo;
    my %catLists;
    while (my ($calName, $incHash) = each %$incInfo) {
        $catLists{$calName} = $incHash-&gt;{Categories};
    }

    # And don't forget to stick the Add-Ins on there
    my @addInNames = $prefs-&gt;getIncludedAddInNames;
    push @dbList, map {AddIn-&gt;new ($_, $self)} @addInNames;

    foreach my $db (@dbList) {
        # First, regular (i.e. not repeating) events
        my ($eventHash, $repeaters, $error, $key, $value);
        ($eventHash, $repeaters, $error) = $db-&gt;getEvents ($fromDate, $toDate);
        # if problem w/AddIn or included calendar, un-include it
        if ($error) {
            if ($db-&gt;isa ('AddIn')) {
                $self-&gt;removeAddIns ($db-&gt;name);
            } else {
                $self-&gt;removeFromIncludeLists ($db-&gt;name);
            }
            next;
        }

        # See if "include" privacy applies for this one
        my $this_ones_prefs = Preferences-&gt;new ($db);
        my $inc_is_private = !$this_ones_prefs-&gt;PrivacyNoInclude;

        while (($key, $value) = (each %$eventHash)) {
            foreach (@$value) {
                next if ($inc_is_private &amp;&amp; ($db != $self) &amp;&amp; $_-&gt;private);

                if ($db != $self) {
                    my $dbname = $db-&gt;name;

                    # If we don't want this category, skip it
                    next unless _wantedCategory ($_, $dbname, \%catLists);

                    $dbname = "ADDIN $dbname" if (ref ($db) eq 'AddIn');
                    $_-&gt;includedFrom ($dbname);
                }

                # Have each event keep track of the preferences for its DB
                if (ref ($db) eq 'AddIn') {
                    $_-&gt;Prefs ($prefs);
                } else {
                    # hmm...does each event really need it's own new Pref obj?
                    $_-&gt;Prefs (Preferences-&gt;new ($db));
                }

                push @{$regularEvents{$key}}, $_;
            }
        }

        # Then repeating events
        foreach (@$repeaters) {
            # skip if private and it's included (and we're enforcing that)
            next if ($inc_is_private &amp;&amp; ($db != $self) &amp;&amp; $_-&gt;private);

            # skip it if completely outside date range
            next if ($_-&gt;repeatInfo-&gt;startDate &gt; $toDate or
                     $_-&gt;repeatInfo-&gt;endDate   &lt; $fromDate);

            if ($db != $self) {
                my $dbname = $db-&gt;name;
                next unless _wantedCategory ($_, $dbname, \%catLists);
                $dbname = "ADDIN $dbname" if (ref ($db) eq 'AddIn');
                # Keep track of where this event was included from
                $_-&gt;includedFrom ($dbname);
            }
            # Have each event keep track of the preferences for its DB
            if (ref ($db) eq 'AddIn') {
                $_-&gt;Prefs ($prefs);
            } else {
                $_-&gt;Prefs (Preferences-&gt;new ($db));
            }

            push @repeatingEvents, $_;
        }
    }

    sub _wantedCategory {
        my ($event, $dbname, $catLists) = @_;
        my $theseCats = $catLists-&gt;{$dbname};
        return 1 unless ($theseCats and @$theseCats);

        return 1 if $event-&gt;inCategory ($theseCats);

        my $noCats;
        foreach (@$theseCats) {
            if ($_ eq '&lt;- - - -&gt;') {
                $noCats = 1;
                last;
            }
        }
        return 1 if ($noCats and !$event-&gt;getCategoryList);
        return undef;
    }

    return (\%regularEvents, \@repeatingEvents);
}

# Pass username and permission level.
sub setPermission {
    my $self = shift;
    my ($userName, $permission) = @_;
    $self = $$self if ($self-&gt;isa ('REF'));
    $self-&gt;{'Imp'}-&gt;setPermission ($userName, $permission);
}

# Pass username; returns current permission level, or undef.
sub getPermission {
    my $self = shift;
    my ($userName) = @_;
    $$self-&gt;{'Imp'}-&gt;getPermission ($userName);
}

# Return hash of username-&gt;perms
sub getPermittedUsers {
    my $self = shift;
    $$self-&gt;{'Imp'}-&gt;getPermittedUsers;
}

# Set the hash of username-&gt;perms
sub setPermittedUsers {
    my $self = shift;
    my $hashRef = shift;
    $$self-&gt;{'Imp'}-&gt;setPermittedUsers ($hashRef);
}

# Return perm level or undef
sub getGroupPermission {
    my ($self, $groupID) = @_;
    $$self-&gt;{Imp}-&gt;getGroupPermission ($groupID);
}

sub setGroupPermission {
    my ($self, $groupID, $level) = @_;
    $$self-&gt;{Imp}-&gt;setGroupPermission ($groupID, $level);
}

sub _removeOrRenameInIncludeLists {
    my $classname = shift;
    my ($name1, $name2) = @_;   # if $name2 defined, we rename, else delete
    my @calendars = MasterDB-&gt;getAllCalendars;

    foreach (@calendars) {
        my $db = Database-&gt;new ($_);
        my $prefs = $db-&gt;getPreferences;
        my $includes = $prefs-&gt;{Includes};
        if ($includes &amp;&amp; defined $includes-&gt;{$name1}) {
            $includes-&gt;{$name2} = $includes-&gt;{$name1} if ($name2);
            delete $includes-&gt;{$name1};
            $db-&gt;setPreferences ({Includes =&gt; $includes});
        }
    }
}

sub removeFromIncludeLists {
    my $classname = shift;
    my ($dbNameToDelete) = @_;
    $classname-&gt;_removeOrRenameInIncludeLists ($dbNameToDelete);
}

sub renameInIncludeLists {
    my $classname = shift;
    my ($oldName, $newName) = @_;
    $classname-&gt;_removeOrRenameInIncludeLists ($oldName, $newName);
}

sub removeAddIns {
    my ($self, @addInNames) = @_;
    my $includes = $self-&gt;getPreferences ('Includes');
    foreach (@addInNames) {
        delete $includes-&gt;{"ADDIN $_"};
    }
    $self-&gt;setPreferences ({Includes =&gt; $includes});
}

sub findEventsMatching {
    my $self = shift;
    my ($text, $fromDate, $toDate, $ignoreCase, $quoteRegex) = @_;
    my %returnHash;
    my $eventHash = $self-&gt;getAllRegularEvents;
    $text = quotemeta ($text) unless $quoteRegex;
    $text = "(?i)$text" if $ignoreCase;
    while (my ($date, $list) = each %$eventHash) {
        next unless (Date-&gt;new ($date))-&gt;inRange ($fromDate, $toDate);
        foreach my $event (@$list) {
            next unless $event-&gt;text =~ /$text/;
            $returnHash{$date} = [] unless $returnHash{$date};
            push @{$returnHash{$date}}, $event;
        }
    }
    \%returnHash;
}

sub findRepeatingEventsMatching {
    my $self = shift;
    my ($text, $fromDate, $toDate, $ignoreCase, $quoteRegex) = @_;
    my @returnList;
    my $eventList = $self-&gt;getAllRepeatingEvents;
    $text = quotemeta ($text) unless $quoteRegex;
    $text = "(?i)$text" if $ignoreCase;
    foreach my $event (@$eventList) {
        next unless $event-&gt;text =~ /$text/;
        next unless ($event-&gt;repeatInfo-&gt;startDate-&gt;inRange ($fromDate,
                                                             $toDate)   ||
                     $event-&gt;repeatInfo-&gt;endDate-&gt;inRange   ($fromDate,
                                                             $toDate));
        push @returnList, $event;
    }
    \@returnList;
}

sub getAllRegularEvents {
    my $self = shift;
    my %args = @_;
    my $hash = $$self-&gt;{'Imp'}-&gt;getAllRegularEvents (@_);
    unless ($args{noPrefs}) {    # keep prefs for each event...for Time Periods
        my $prefs = $self-&gt;getPreferences;
        foreach my $date (keys %$hash) {
            foreach my $event (@{$hash-&gt;{$date}}) {
                $event-&gt;Prefs ($prefs);
            }
        }
    }
    return $hash;
}

sub getAllRepeatingEvents {
    my $self = shift;
    my %args = @_;
    my $list = $$self-&gt;{'Imp'}-&gt;getAllRepeatingEvents (@_);
    unless ($args{noPrefs}) {    # keep prefs for each event...for Time Periods
        my $prefs = $self-&gt;getPreferences;
        foreach my $event (@$list) {
            $event-&gt;Prefs ($prefs);
        }
    }
    return $list;
}

# set/get file to log events to
sub auditingFile {
    my $self = shift;
    my $filename = shift;
    return $$self-&gt;{'Imp'}-&gt;getAuditFile unless $filename;
    $$self-&gt;{'Imp'}-&gt;setAuditFile ($filename);
}
# set/get list of email addresses to log events to
sub auditingEmail {
    my $self = shift;
    my (@emails) = @_;
    unless (@emails) {
        my $string = $$self-&gt;{'Imp'}-&gt;getAuditEmailAddresses || '';
        return (wantarray ? split /\s/, $string : $string);
    }
    my $emailString = join ' ', @emails;
    $$self-&gt;{'Imp'}-&gt;setAuditEmailAddresses ($emailString);
}

# Pass op and list of Auditing types ('file', 'email')
sub setAuditing {
    my $self = shift;
    my ($opName, @auditList) = @_;
    my $auditString = join ' ', @auditList;
    $$self-&gt;{'Imp'}-&gt;setAuditing ($opName, $auditString);
}

# Pass op type or name; returns list of Auditing types (current types:
# 'file' 'email')
sub getAuditing {
    my $self = shift;
    my ($opName) = @_;
    my $auditString = $$self-&gt;{'Imp'}-&gt;getAuditing ($opName) || '';
    split /\s/, $auditString;
}

# Ug. In addition to modifying prefs, have to find and modify all events in
# this category.
# "Flags" arg controls what to do. If:
#     undef     change in preferences and events
#     /prefs/   change prefs
#     /events/  change events
sub renameCategory {
    my ($self, $oldName, $newName, $flags) = @_;
    return unless ($oldName and $newName);

    if (!$flags or ($flags =~ /prefs/)) {
        my $prefs = $self-&gt;getPreferences;
        my $newCat = $prefs-&gt;category ($oldName);
        return unless $newCat;
        $newCat-&gt;name ($newName);
        $prefs-&gt;category ($newName, $newCat);
        $prefs-&gt;deleteCategory ($oldName);
        $self-&gt;setPreferences ($prefs);
    }

    return if ($flags and ($flags !~ /events/));

    $self-&gt;begin_transaction;

    my $regHash = $self-&gt;getAllRegularEvents;
    my $repeats = $self-&gt;getAllRepeatingEvents;

    foreach my $date (keys %$regHash) {
        foreach my $event (@{$regHash-&gt;{$date}}) {
            if (_renameCatInEvent ($event, $oldName, $newName)) {
                $self-&gt;replaceEvent ($event, $date);
            }
        }
    }
    foreach my $event (@$repeats) {
        if (_renameCatInEvent ($event, $oldName, $newName)) {
            $self-&gt;replaceEvent ($event);
        }
    }

    $self-&gt;end_transaction;

    return;

    sub _renameCatInEvent {
        my ($event, $oldName, $newName) = @_;
        return unless $event-&gt;inCategory ($oldName);
        my @evCats = $event-&gt;getCategoryList;
        my $saveIt;
        foreach my $thisCat (@evCats) {
            if ($thisCat eq $oldName) {
                $thisCat = $newName;
                $saveIt = 1;
                last;
            }
        }
        return unless $saveIt;
        $event-&gt;setCategoryList (@evCats);
        return 1;
    }
}

sub isSyncing {
    my $self = shift;
    $self = $$self if ($self-&gt;isa ('REF')); # urg
    $self-&gt;{isSyncing} = shift if (@_);
    $self-&gt;{isSyncing};
}
sub isLockedForSync {
    my ($self) = @_;
    return undef if $self-&gt;isa ('MasterDB'); # Master can't be synced.
    return undef unless -d $self-&gt;syncLockDirName;

    # lock dir exists, see if expired
    my $expireTime = $self-&gt;_getLockExpiration;
    return 1 if ($expireTime &gt; time); # lock still good

    # lock expired; remove lock dir and file, return undef - we're not locked
    $self-&gt;lockForSync;
    return undef;
}
sub syncLockDirName {
    my ($self) = @_;
    return $self-&gt;_getBaseFilename . '.SyncLock';
}
sub syncLockExpiryFileName {
    my ($self) = @_;
    my $expireFile = $self-&gt;syncLockDirName . "/expireTime";
}
sub _getLockExpiration {
    my ($self) = @_;
    my $lockDir = 
    my $expireFile = $self-&gt;syncLockExpiryFileName;
    open (TIMEOUT, "&lt; $expireFile") or return -1;
    my $expiry = &lt;TIMEOUT&gt;;
    return $expiry + 0;
}

# Pass number of seconds to lock for; undef to unlock.
# Return undef if lock or unlock fails
sub lockForSync {
    my ($self, $lockTime) = @_;

    # For now, just create or test for existence of a lockfile.
    my $lockDir = $self-&gt;syncLockDirName;
    my $expireFile = $self-&gt;syncLockExpiryFileName;

    # if locking, create dir and file containing expire time
    if (defined $lockTime) {

        return undef if $self-&gt;isLockedForSync;

        mkdir ($lockDir, 0777) or return undef;
        sysopen (TIMEOUT, $expireFile, O_WRONLY|O_CREAT|O_EXCL)
            or return undef;
        my $expiry = time + $lockTime;
        print TIMEOUT "$expiry\n";
        close TIMEOUT or return undef;
        return 1;
    } else {                    # otherwise, unlock; remove file and dir
        $self = $$self if ($self-&gt;isa ('REF')); # urg
        $self-&gt;{_error} = '';
        my $unlink_count = unlink $expireFile;
        unless ($unlink_count) {
            $self-&gt;{_error} .= "Removing file '$expireFile' failed: $!\n";
        }
        my $rmdir_ok = rmdir ($lockDir);
        unless ($rmdir_ok) {
            $self-&gt;{_error} .= "Removing sync lock dir '$lockDir' failed: $!\n";
        }
        return $unlink_count &amp;&amp; $rmdir_ok;
    }
}

# Make copy of event data which we can revert to if necessary.
# Return 1 on success, 0 on failure.
sub backupForSync {
    my ($self) = @_;
    require Calendar::SyncInfo;
    SyncInfo-&gt;new ($self-&gt;name)-&gt;backupForSync;
    $$self-&gt;{'Imp'}-&gt;backupForSync;
}

# Return 1 on success, 0 on failure.
sub revertForSync {
    my ($self) = @_;
    SyncInfo-&gt;new ($self-&gt;name)-&gt;revertForSync;
    $$self-&gt;{'Imp'}-&gt;revertForSync;
}

# Transaction locks; lock/unlock around atomic ops
sub begin_transaction {
    my $self = shift;
    $$self-&gt;{Imp}-&gt;begin_transaction;
}
sub end_transaction {
    my $self = shift;
    $$self-&gt;{Imp}-&gt;end_transaction;
}

sub error {
    my $self = shift;
    return $$self-&gt;{_error};
}

1;
</pre></body></html>