|
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/Operation/ |
Upload File : |
# Copyright 1999-2003, Fred Steinberg, Brown Bear Software
# Manage Add-In files; add/delete/subscribe
package AdminAddInsAdmin;
use strict;
use CGI;
use vars ('@ISA');
@ISA = ('Operation');
sub perform {
my $self = shift;
my ($newName, $doUpload, $doGetURL, $uploadFile, $addinURL,
$delete, $refresh, $cancel) =
$self->getParams (qw (NewName DoUpload DoGetURL UploadFile AddInURL
Delete Refresh Cancel));
my $calName = $self->calendarName;
my $i18n = $self->I18N;
my $db = $self->db;
my $cgi = new CGI;
if ($cancel) {
my $op = $calName ? 'AdminPage' : 'SysAdminPage';
print $self->redir ($self->makeURL ({Op => $op}));
return;
}
my $prefs = $self->prefs;
my $masterPrefs = defined $calName ? MasterDB->new->getPreferences
: $prefs;
my $message;
if ($refresh) {
{
my @refresh = $cgi->param ('RefreshThese');
eval {require LWP::Simple;};
if ($@) {
$message =
$i18n->get ("Sorry: the Perl module `LWP::Simple' does " .
"not seem to be installed; can't retrieve " .
"the file!");
last;
}
my $ok = 0;
foreach my $name (@refresh) {
my $addIn = AddIn->new ($name, $db);
my $url = $addIn->sourceLocation;
next unless $url;
$url = _normalizeURL ($url);
my $contents = LWP::Simple::get ($url);
if (!defined $contents) {
$message .= $i18n->get ('Error') . ': ' .
$i18n->get ("Couldn't retrieve ") . $url;
}
my $err = $addIn->replaceSourceFile ($db, $contents);
if ($err) {
$err = 'Unrecognized Add-In file format'
if ($err eq 'bad file type');
$message .= "$name: $err<br>";
} else {
$ok++;
}
}
last if $message;
$message = "$ok " . ($ok == 1 ? $i18n->get ('Add-In was refreshed')
: $i18n->get ('Add-Ins were refreshed'));
}
}
elsif ($doUpload) {
{
if (!defined $uploadFile or $uploadFile eq '') {
$message =
$i18n->get ("Error: You didn't specify a file to load!");
last;
}
last if ($message = _checkName ($newName, $i18n, $db));
my $fh;
if ($CGI::VERSION < 2.47) {
$fh = $cgi->param ('UploadFile');
$fh = undef unless (ref $fh and fileno ($fh));
} else {
$fh = $cgi->upload ('UploadFile');
}
if (!$fh) {
$message = $i18n->get ('Error') . $cgi->cgi_error;
last;
}
my @lines = <$fh>;
my $name = $newName;
$message = $self->_processNewFile ($name, \@lines);
}
}
elsif ($doGetURL) {
{
if (!defined $addinURL or $addinURL eq '') {
$message =
$i18n->get ("Error: You didn't specify a URL!");
last;
}
last if ($message = _checkName ($newName, $i18n, $db));
eval {require LWP::Simple;};
if ($@) {
$message =
$i18n->get ("Sorry: the Perl module `LWP::Simple' does " .
"not seem to be installed; can't retrieve " .
"the file!");
last;
}
my $normURL = _normalizeURL ($addinURL); # Convert "webcal" to "http"
my $contents = LWP::Simple::get ($normURL);
if (!defined $contents) {
$message = $i18n->get ('Error') . ': ' .
$i18n->get ("Couldn't retrieve ") . $normURL;
last;
}
$message = $self->_processNewFile ($newName, $contents, $addinURL);
}
}
elsif ($delete) {
my @delete = $cgi->param ('DeleteThese');
my $ok = 0;
foreach (@delete) {
$ok++ if AddIn->deleteFiles ($db, $_);
}
# Remove from include lists
$db->removeAddIns (@delete);
$message = "$ok " . ($ok == 1 ? $i18n->get ('Add-In was deleted')
: $i18n->get ('Add-Ins were deleted'));
}
# And display (or re-display) the form
print $cgi->header;
print $cgi->start_html (-title => $i18n->get ('Manage Add-In Files') .
($calName ||
$i18n->get ('System Defaults')),
-bgcolor => 'white');
if ($calName) {
print GetHTML->AdminHeader (I18N => $i18n,
cal => $calName || '',
section => 'Manage Add-In Files');
} else {
print GetHTML->SysAdminHeader ($i18n, 'Manage Add-In Files', 1);
}
print '<br>';
print "<center><font color='red' size=+1>$message</font></center><hr>"
if $message;
# Print existing AddIn files found on disk for this calendar (or System)
my @addIns = sort {lc ($a) cmp lc ($b)} AddIn->getAddInFilenames ($db);
print $cgi->start_multipart_form;
my $existTitle = $i18n->get ('Existing Add-In files for') . ' ';
$existTitle .= defined $calName ? $calName : $i18n->get ('all calendars');
print '<center>';
print '<big>', $cgi->b ($existTitle), '</big><br>';
print $cgi->scrolling_list (-name => 'DeleteThese',
-values => \@addIns,
-size => @addIns > 5 ? 10 : 5,
-multiple => 1);
print '<br>';
print $cgi->submit (-name => 'Delete',
-value => $i18n->get ('Delete Selected Add-In files'));
print '<br><hr width="50%"><br>';
print '<big>', $cgi->b ($i18n->get ('Install new Add-In file')),
'</big><br>';
print '</center>';
my @rows;
push @rows,
$cgi->Tr ($cgi->td ($cgi->b ('1.')),
$cgi->td ($cgi->b
($i18n->get
('Specify a name for the new Add-In'))));
push @rows,
$cgi->Tr ($cgi->td (' '),
$cgi->td ($cgi->textfield (-name => 'NewName',
-size => 40,
-maxlength => 60)),
$cgi->td ($cgi->font ({-size => -1},
$i18n->get ('Any combination of ' .
'letters, digits, ' .
'and underscores'))));
push @rows, $cgi->Tr ($cgi->td (' '));
push @rows,
$cgi->Tr ($cgi->td ($cgi->b ('2.')),
$cgi->td ($cgi->b
($i18n->get ('Upload a new Add-In file'))));
push @rows,
$cgi->Tr ($cgi->td (' '),
$cgi->td ($cgi->filefield (-name => 'UploadFile',
-size => 40,
-maxlength => 120)),
$cgi->td ($cgi->submit (-name => 'DoUpload',
-value => $i18n->get ('Do Upload'))));
push @rows, $cgi->Tr ($cgi->td (' '),
$cgi->td ('<b>-' . $i18n->get ('or') . '-</b>'));
push @rows, $cgi->Tr ($cgi->td (' '),
$cgi->td
($cgi->b ($i18n->get ('Install a new Add-In file ' .
'from a URL'))));
push @rows, $cgi->Tr ($cgi->td (' '),
$cgi->td
($cgi->textfield (-name => 'AddInURL',
-size => 40,
-maxlength => 200)),
$cgi->td
($cgi->submit
(-name => "DoGetURL",
-value => $i18n->get ('Retrieve File'))));
print $cgi->table (@rows);
print '<br><center><hr width="50%"><br>';
print '<big>', $cgi->b ($i18n->get ('Reload existing Add-In files')),
'</big><br>';
# find which existing ones have a URL
my (@addInSources, %labels);
foreach my $addIn (AddIn->getAddIns ($db)) {
next unless (my $source = $addIn->sourceLocation);
push @addInSources, $addIn->name;
$labels{$addIn->name} = $addIn->name . " -- $source";
}
@addInSources = sort {lc ($a) cmp lc ($b)} @addInSources;
print $cgi->scrolling_list (-name => 'RefreshThese',
-values => \@addInSources,
-labels => \%labels,
-size => @addInSources > 5 ? 10 : 5,
-multiple => 1);
print '<br>';
print $cgi->submit (-name => 'Refresh',
-value => $i18n->get ('Reload Selected Add-In files'));
print '</center><br>';
print '<hr>';
print $cgi->submit (-name => 'Cancel',
-value => $i18n->get ('Done'));
print ' ';
print $cgi->hidden (-name => 'Op', -value => __PACKAGE__);
print $cgi->hidden (-name => 'CalendarName', -value => $calName)
if (defined $calName);
print $self->hiddenDisplaySpecs;
print $cgi->reset (-value => 'Reset');
print $cgi->endform;
my (@notes, $note);
if ($calName) {
$note = $i18n->get ('AdminAddInsAdmin_added');
if ($note eq 'AdminAddInsAdmin_added') {
$note = qq (New Add-In files will be included in the calendar.
Use the Add-Ins admin page to set colors, etc.);
}
push @notes, $note;
}
$note = $i18n->get ('AdminAddInsAdmin_format');
if ($note eq 'AdminAddInsAdmin_format') {
$note = qq (Add-In files can be in Calcium or vCalendar format.);
}
push @notes, $note;
$note = $i18n->get ('AdminAddInsAdmin_url');
if ($note eq 'AdminAddInsAdmin_url') {
$note = qq (To automatically retrieve an Add-In file from a
location on the web, just enter the URL, e.g. <i>
http://www.brownbearsw.com/AddIns/USHolidays.ics</i>
(A URL starting with <i>webcal://</i> will work too.));
}
push @notes, $note;
$note = $i18n->get ('AdminAddInsAdmin_refresh');
if ($note eq 'AdminAddInsAdmin_refresh') {
$note = qq (You can automatically refresh Add-Ins that were
originally retrieved from the web. If the URL has
changed, you\'ll need to delete it and retrieve it
again. Refreshing an Add-In will remove any existing
user subscriptions to individual events from that
Add-In file.);
}
push @notes, $note;
print '<b>' . $i18n->get ('Notes') . ':</b><ul>';
foreach (@notes) {
print '<li>' . $i18n->get ($_), '</li>';
}
print '</ul>';
print $cgi->end_html;
}
sub _checkName {
my ($name, $i18n, $db) = @_;
# Make sure the name has only simple chars.
if (!defined $name or $name eq '') {
return $i18n->get ("Error: You must specify a name for the new Add-In.");
}
if ($name =~ /\W/) {
return $i18n->get ('Error: only letters, digits, and the ' .
'underscore are allowed in Add-In names.');
}
# And make sure it doesn't already exist
my @addIns = AddIn->getAddInFilenames ($db);
my $found = grep /^$name$/, @addIns;
if ($found) {
return $i18n->get ("Error: couldn't write new Add-In file.")
. " '$name' " . $i18n->get ('already exists.');
}
return;
}
# Return list (Error, Message). Error undef if ok
sub _processNewFile {
my ($self, $name, $lines, $url) = @_;
my $message;
my $db = $self->db;
my $i18n = $self->I18N;
if ($message = AddIn->writeNewFile ($db, $name, $lines)) {
$message = $i18n->get ("Error: couldn't write new Add-In file.")
. " $message";
return $message;
}
# Count events
my $addIn = AddIn->new ($name, $db);
$addIn->openDatabase ('read'); # just to compile the source
$addIn->closeDatabase;
my ($reg, $rep, $type) = ($addIn->getCounts, $addIn->getType);
if ($type eq 'unknown') {
AddIn->deleteFiles ($db, $name);
$message = 'Unrecognized Add-In file format; not saved.';
my $lines = $addIn->getBadLines;
$message .= '<br>First few lines: <br>';
$message .= "<xmp>@$lines[0..2]</xmp>";
return $message;
}
# Save URL for this AddIn, if we got one.
if ($url) {
$addIn->sourceLocation ($url);
}
$message = $i18n->get ('Created Add-In File') . ": $name";
$message .= "<br>Regular: $reg, Repeat: $rep, Type: $type";
# turn on AddIn in this calendar, unless we're adding a System Addin
if ($self->calendarName) {
my $incInfo = $db->getPreferences ('Includes');
$incInfo->{"ADDIN $name"} = {Included => 1};
$db->setPreferences ({Includes => $incInfo});
}
return $message;
}
sub _normalizeURL {
my $url = shift;
$url =~ s/^\s*//;
$url =~ s/^\s$//;
$url =~ s/^webcal:/http:/; # Convert "webcal" to "http"
$url = "http://$url" # Stick an http on front if not there
unless ($url =~ /^http/);
return $url;
}
sub auditString {
my ($self, $short) = @_;
return unless $self->{audit_formsaved};
my $line = $self->SUPER::auditString ($short);
$line;
}
1;