|
Server : Apache/2.4.62 System : FreeBSD fbsdweb2.web.rcn.net 14.1-RELEASE FreeBSD 14.1-RELEASE releng/14.1-n267679-10e31f0946d8 GENERIC amd64 User : www ( 80) PHP Version : 8.3.8 Disable Function : NONE Directory : /domains/compasssysweb/calendar/CalciumDir39/Calendar/ |
Upload File : |
# Copyright 1999-2003, Fred Steinberg, Brown Bear Software
# AddIn.pm - a special Database of pre-defined events
# Inherits from Database
package AddIn;
use strict;
use File::Basename;
use Calendar::Defines;
use Calendar::Database;
use Calendar::Date;
use Calendar::Event;
use Calendar::RepeatInfo;
use vars ('@ISA');
@ISA = ("Database");
sub new {
my ($class, $name, $db) = @_;
my $self = $class->SUPER::new ($name);
my $dir = $class->_getDir ($db);
$$self->{_AddInData} = {dir => $dir}; # i.e. cal we're associated with.
# Note that Database is ref to
# hashref, hence $$
bless $self, $class;
}
sub _myData {
my ($self, $key) = @_;
$self = $$self if ($self->isa ('REF')); # oh dear; see Database.pm
return $self->{_AddInData}->{$key};
}
sub _setMyData {
my ($self, $key, $value) = @_;
$self = $$self if ($self->isa ('REF')); # oh dear; see Database.pm
$self->{_AddInData}->{$key} = $value;
}
# Return list of all the available AddIn objects for specified cal, or system
sub getAddIns {
my ($classname, $db) = @_;
my @names = $classname->getAddInFilenames ($db);
my @addIns;
foreach (@names) {
push @addIns, $classname->new ($_, $db);
}
return @addIns;
}
# Return list of add-in filenames for specified calendar, or system
sub getAddInFilenames {
my ($class, $db) = @_;
my $dir = $class->_getDir ($db);
return unless (-d $dir); # if no dir, no files
opendir (DIR, $dir) or die "Oopsie; Can't open AddIn dir $dir: $!\n";
my @files = readdir(DIR);
closedir DIR;
my @addIns = grep { -f } # we only want files
grep { -r } # ignore those we can't read
map { "$dir/$_"} # get full pathname
grep {!/\W/} # only files w/valid calendar names
grep {!/^\.\.?$/} # ignore . and ..
@files; # get all files in directory
@addIns = map {basename $_} @addIns;
return @addIns;
}
# $lines can be string or array ref of lines
# return false on success, message on error
sub writeNewFile {
my ($class, $db, $fname, $lines) = @_;
my $dir = $class->_getDir ($db);
# Create main AddIn dir if it doesn't exist
if (!-d $class->_getDir) {
my $main = $class->_getDir;
warn "Creating main AddIn directory $main\n";
if (!mkdir ($main, 0777)) {
warn "Error: can't create directory $main: $!\n";
return "create dir '$main' failed";
}
}
# Create dir if it doesn't exist
if (!-d $dir) {
warn "Creating AddIn directory $dir\n";
if (!mkdir ($dir, 0777)) {
warn "Error: can't create directory $dir: $!\n";
return "create dir '$dir' failed";
}
}
unless (-d $dir and -w $dir) {
warn "Can't open new Add-In file; $dir not a writable directory\n";
return "$dir not a writeable directory";
}
if (-e "$dir/$fname") {
warn "new Add-In file $dir/$fname already exists\n";
return "'$fname' already exists";
}
if (!open (ADDIN, "> $dir/$fname")) {
warn "Can't open new Add-In file $dir/$fname for writing: $!\n";
return "Can't write to $dir/$fname";
}
$lines = join '', @$lines if (ref ($lines) eq 'ARRAY');
print ADDIN $lines;
print ADDIN "\n";
close ADDIN;
return;
}
sub deleteFiles {
my ($class, $db, $name, $datOnly) = @_;
my $dir = $class->_getDir ($db);
my $datDir = "$dir/dat";
my @datFiles;
if (opendir (DIR, $datDir)) {
@datFiles = readdir(DIR);
closedir DIR;
}
# First, remove any dat files
my @myDatFiles = grep {/^$name\./} @datFiles;
if (@myDatFiles) {
unlink map {"$datDir/$_"} @myDatFiles;
}
return 1 if $datOnly;
# Remove source AddIn file
return unlink "$dir/$name";
}
sub replaceSourceFile {
my ($self, $db, $lines) = @_;
my $tempName = $self->_sourceFilename . '.temp';
rename ($self->_sourceFilename, $tempName);
my $err = $self->writeNewFile ($db, $self->name, $lines);
if ($err) {
rename ($tempName, $self->_sourceFilename);
return $err;
}
$self->openDatabase ('read'); # compile new version
$self->closeDatabase;
if ($self->getType eq 'unknown') {
rename ($tempName, $self->_sourceFilename);
$self->deleteFiles ($db, $self->name, 'datOnly');
return 'bad file type';
}
return;
}
sub renameCalendarDir {
my ($class, $oldName, $newName) = @_;
return unless (defined $oldName and defined $newName);
my $oldDir = Defines->baseDirectory . '/data/AddIns/' . $oldName;
my $newDir = Defines->baseDirectory . '/data/AddIns/' . $newName;
return unless -d $oldDir;
return if -d $newDir;
rename ($oldDir, $newDir) ||
warn "Couldn't rename $oldDir to $newDir: $!\n";
}
sub removeCalendarDir {
my ($class, $db) = @_;
return if ($db->isa ('MasterDB'));
my $dir = $class->_getDir ($db);
return unless (-d $dir);
require File::Path;
return File::Path::rmtree ($dir); # Remove it!
}
# Return full filesystem path to Master AddIn dir, or calendar specific one
sub _getDir {
my ($classOrObj, $db) = @_;
if (ref $classOrObj) {
return $classOrObj->_myData ('dir');
}
my $dir = Defines->baseDirectory . '/data/AddIns';
if (defined $db and !$db->isa ('MasterDB')) {
$dir .= '/' . $db->name;
}
return $dir;
}
# Return path of AddIn compiled datafile basename.
sub _getBaseFilename {
my $self = shift;
return $self->_getDir . '/dat/' . $self->name;
}
# Return full path of the actual Add-In file ("source code")
sub _sourceFilename {
my $self = shift;
return $self->_getDir . '/' . $self->name;
}
# Create the datafile if it doesn't exist or is older than the source file.
# Then, call openDatabase in the parent to actually open the database.
sub openDatabase {
my $self = shift;
my $sourcefile = $self->_sourceFilename;
# If source doesn't exist in cal-specific dir, use system dir
if (!-e $sourcefile) {
$self->_setMyData ('dir', Defines->baseDirectory . '/data/AddIns');
$sourcefile = $self->_sourceFilename;
}
my $filename = $self->_getFilename;
# See if we need to parse and build the AddIns
my $ok = 1;
if (!-e $filename or (-M $filename > -M $sourcefile)) {
$ok = $self->_compileSource;
}
if ($ok) {
$self->SUPER::openDatabase (@_);
}
}
# Convert the Add-In text 'sourcefile' into a datafile with the structure
# we expect.
sub _compileSource {
my $self = shift;
open (ADDIN, '<' . $self->_sourceFilename)
or die "Error: Can't open Add-In file!\n " .
$self->_sourceFilename . ": $!\n";
warn "Compiling AddIn " . $self->name . "\n";
# Create the dat dir, if it doesn't exist
my $datDir = $self->_getDir . '/dat';
mkdir ($datDir, 0777) || die "Error: can't create directory $datDir: $!\n"
unless (-d $datDir);
# Create the data file; don't use openDatabase, or we'll loop
$self->createDatabase ('overwrite');
# Grab all the lines
my @lines = <ADDIN>;
close ADDIN;
# See if it's a vCalendar addin; else Calcium format
my $type = 'unknown';
foreach (@lines) {
if (/BEGIN:V/) {
$type = 'vCal';
last;
}
if (/\|/) {
# looks like a Calcium Addin, make sure
next if /^\s*\#/;
my ($text, $date) = split /\|/;
$date =~ s/^\s+//;
$date =~ s/\s+$//;
if ($date =~ m{\d+/\d+(/\d+)?$}) { # make sure it's valid
$type = 'Calcium';
} else {
$type = 'unknown';
}
last;
}
}
my ($repeats, $regulars);
if ($type eq 'vCal') {
($repeats, $regulars) = $self->_compilevCalendarFile (\@lines);
$type = 'vCalendar';
} elsif ($type eq 'Calcium') {
($repeats, $regulars) = $self->_compileCalciumFile (\@lines);
$type = 'Calcium AddIn';
} else {
warn "Unknown AddIn file format: " . $self->_sourceFilename . "\n";
$self->_setMyData ('type', $type);
$self->_setMyData ('badLines', [@lines[0..4]]);
return;
}
$self->_setMyData ('type', $type);
$self->_setMyData ('repeatCount', scalar (@$repeats));
$self->_setMyData ('regularCount', scalar (@$regulars / 2));;
$self->insertEvents ($repeats);
$self->insertEvents ($regulars);
return 1;
}
sub _compileCalciumFile {
my ($self, $lines) = @_;
# Read and set the description from the first non-comment, non-blank
# line
while (@$lines) {
my $line = shift @$lines;
next if ($line =~ /^\#/ or $line =~ /^$/);
chomp $line;
$self->description ($line);
last;
}
my (@repeaterList, @regularList);
my $future = Date->openFuture;
# Continue with the events
local $_;
foreach (@$lines) {
# this, of course, needs help!
next if /^\#/ or /^$/;
my ($text, $date);
($text, $date) = split /\|/;
$text =~ s/^\s+//;
$text =~ s/\s+$//;
$date =~ s/^\s+//;
$date =~ s/\s+$//;
my $start = Date->openPast;
my (@fields, $repeat);
(@fields) = split /\//, $date;
if (@fields == 2) {
$start->month ($fields[0]);
$start->day ($fields[1]);
$repeat = RepeatInfo->new ($start, $future, 'year', '1');
} elsif (@fields == 3) {
if ($fields[0] > 999) {
$start->year ($fields[0]);
$start->month ($fields[1]);
$start->day ($fields[2]);
} else {
my ($nth, $dow, $month) = @fields;
$start = Date->getNthWeekday ($start->year, $month, $dow,$nth);
$repeat = RepeatInfo->new ($start, $future, undef, undef,
$nth, 12);
}
}
my $newEvent = Event->new (text => $text,
export => 'Public',
repeatInfo => $repeat);
if ($repeat) {
push @repeaterList, $newEvent;
} else {
push @regularList, ($newEvent, $start);
}
}
return (\@repeaterList, \@regularList);
}
sub _compilevCalendarFile {
my ($self, $lines) = @_;
my (@repeaterList, @regularList);
require Calendar::EventvEvent;
require Calendar::vCalendar::vCalendar;
my $vcal = vCalendar->new (lines => $lines);
my $name = $vcal->getName;
$self->description ($name) if defined $name;
my $vEvents = $vcal->events;
foreach (@$vEvents) {
my ($event, $date) = Event->newFromvEvent ($_);
next unless $event;
if ($event->isRepeating) {
push @repeaterList, $event;
} else {
push @regularList, ($event, $date);
}
}
return (\@repeaterList, \@regularList);
}
sub getType {
my $self = shift;
return $self->_myData ('type');
}
sub getCounts {
my $self = shift;
return ($self->_myData ('regularCount'), $self->_myData ('repeatCount'));
}
sub getBadLines {
my $self = shift;
return $self->_myData ('badLines'); # ref to array of some lines
}
# Store a URL so we can refresh
sub sourceLocation {
my $self = shift;
if (@_) {
$self->setPreferences ({MailSignature => shift});
} else {
return $self->getPreferences ('MailSignature');
}
}
1;