#!/usr/local/bin/perl -w # ---------------------------------------------------------------------------- # MyDiary.pl - a Perl Diary Script # Copyright (c) 2001 Jason M. Hinkle. All rights reserved. This script is # free software; you may redistribute it and/or modify it under the same # terms as Perl itself. # For more information see: http://www.verysimple.com/scripts/ # # LEGAL DISCLAIMER: # This software is provided as-is. Use it at your own risk. The # author takes no responsibility for any damages or losses directly # or indirectly caused by this software. # # VERSION HISTORY # 1.2.5 - fixed result page weirdness & lots of display options # 1.2.4 - patch for FNF bug & better error reporting # 1.2.3 - fixed date formatting bug # 1.2.2 - fixed result paging bug # 1.2.1 - added DescendingSort and BannerText # 1.2.0 - combined private.pl, public.pl and setup.pl into one file # 1.1.0 - original release # ---------------------------------------------------------------------------- my $VERSION = "1.2.5"; BEGIN { ######################################################################## # Config Variables # ######################################################################## # this is the relative path to the config file. update only if necessary $ENV{"CONFIG_FILE"} = "/data/MyDiary.cfg"; # This is the installation path for the script. If you recieve an error telling you to manually set # the path, replace GetCwd($ENV{"CONFIG_FILE"}) with the full path to your script for example: # $ENV{"CWD"} = "C:/wwwroot/cgi-bin/myscript"; # Leave off any trailing slashes, and replace all backslashes "\" with forward slashes "/" $ENV{"CWD"} = GetCwd($ENV{"CONFIG_FILE"}); # uncomment this line if you are experiencing 404 errors $ENV{"SCRIPT_NAME"} = "MyDiary.cgi"; # uncomment for faster perceived performance (warning: may cause some browsers to hang) # $| = 1; ######################################################################## # End Config Variables # ######################################################################## # add the current directory to the perl path so our libraries can be found push(@INC,$ENV{"CWD"}); sub GetCwd { # this function tries various methods to get the installation directory. if it is not found, # an error is displayed telling the user to edit the script manually my ($testFile) = shift || ""; # try to get install path from env vars first, if that doesn't work, try Cwd, otherwise, fail. # all the wierd || business is to prevent uninitialized var warnings my ($fullPath) = $ENV{"PATH_TRANSLATED"} || $ENV{"SCRIPT_FILENAME"} || ( ($ENV{"DOCUMENT_ROOT"} || "") . ($ENV{"SCRIPT_NAME"} || "") ) || "./"; $fullPath =~ s|\\|\/|g; my ($filePath) = substr($fullPath,0, rindex($fullPath,"/")); if (-e "$filePath/$testFile") { return $filePath } # fist method failed, now try Cwd use Cwd; $filePath = Cwd::cwd(); if (-e "$filePath/$testFile") { return $filePath } # both methods failed. Print a friendly error print "Content-type: text/html\n\n"; print "Installation path could not be determined.\n"; print "
Please edit the script and set \$ENV{\"CWD\"} to the full path in which the script is installed."; exit 1; } } # / BEGIN # ---------------------------------------------------------------------------- print "Content-type: text/html\n\n"; eval 'use vsDB'; eval 'use CGI'; # --- get the configuration settings my ($configFilePath) = $ENV{"CWD"} . $ENV{"CONFIG_FILE"}; my ($objConfig) = new vsDB( file => $configFilePath, delimiter => "\t", ); if (!$objConfig->Open) { print "An error occured while opening the configuration file!"; print "
Make sure that you have specified the correct path and that file permissions are set correctly."; print "
Details: " . $objConfig->LastError; exit 1; } my ($title) = $objConfig->FieldValue("Title"); my ($bannerText) = $objConfig->FieldValue("BannerText"); my ($backgroundImage) = $objConfig->FieldValue("BackgroundImage"); my ($headerColor) = $objConfig->FieldValue("HeaderColor"); my ($headerTextColor) = $objConfig->FieldValue("HeaderTextColor"); my ($textColor) = $objConfig->FieldValue("TextColor"); my ($fontFace) = $objConfig->FieldValue("FontFace"); my ($tableColor) = $objConfig->FieldValue("TableColor"); my ($privateIcon) = $objConfig->FieldValue("PrivateIcon"); my ($publicIcon) = $objConfig->FieldValue("PublicIcon"); my ($fileName) = $objConfig->FieldValue("FileName") || "calendar.tab"; my ($delimiter) = $objConfig->FieldValue("Delimiter") || "\t"; my ($descOrder) = $objConfig->FieldValue("DescendingOrder") || 0; my ($authUserId) = $objConfig->FieldValue("UserId") || "*"; my ($authPassword) = $objConfig->FieldValue("Password") || "*"; # -- end config my ($filePath) = $ENV{"CWD"} . "/" . $fileName; # print the header print "
$title |
\n"; print "$bannerText \n"; print "
\n"; my ($scriptName) = $ENV{'SCRIPT_NAME'} || "private.pl"; my ($objCGI) = new CGI; my ($command) = $objCGI->param('vsCOM') || ""; my ($id) = $objCGI->param('vsID') || ""; my ($activePage) = $objCGI->param('vsAP') || ""; my ($userId) = $objCGI->param('vsUserId') || ""; my ($password) = $objCGI->param('vsPassword') || ""; my ($dontPrintAll) = 0; my ($isAdministrator) = 0; $isAdministrator = 1 if ($userId eq $authUserId && $password eq $authPassword); my ($objDB) = new vsDB( file => $filePath, delimiter => $delimiter, ); # if datafile is not found, go to setup screen, or allow login if (!$objDB->Open) { print "An error occured while opening the data file!"; print "
Make sure that you have specified the correct path and that file permissions are set correctly."; print "
Details: " . $objDB->LastError; $command = "SETUP" unless ($command eq "SETUPUPDATE" || $command eq "LOGIN") ; } if ($command eq "ADD") { PrintBlankRecord(); $dontPrintAll = 1; } elsif ($command eq "LOGIN") { PrintLogin(); $dontPrintAll = 1; } elsif ($command eq "EDIT") { $objDB->Filter("Id","eq",$id); if ($isAdministrator) { PrintCurrentRecord($objDB); } else { PrintCurrentRecordReadOnly($objDB); } $dontPrintAll = 1; } elsif ($command eq "UPDATE" && $isAdministrator) { $objDB->Filter("Id","eq",$id); UpdateCurrentRecord($objDB,$objCGI); } elsif ($command eq "SETUP" && $isAdministrator) { PrintSetup($objConfig); $dontPrintAll = 1; } elsif ($command eq "SETUPUPDATE" && $isAdministrator) { UpdateSetup($objConfig,$objCGI); $dontPrintAll = 1; } elsif ($command eq "DELETE" && $isAdministrator) { $objDB->Filter("Id","eq",$id); $objDB->Delete; $objDB->Commit; } elsif ($command eq "INSERT" && $isAdministrator) { $objDB->AddNew; my ($newId) = $objDB->Max("Id") || 0; $newId = int($newId) + 1; $objDB->FieldValue("Id",$newId); UpdateCurrentRecord($objDB,$objCGI); } # show the default screen if specified unless ($dontPrintAll) { $objDB->RemoveFilter; $objDB->Sort("Date",$descOrder); # only the administrator can view private posts $objDB->Filter("Private","ne","checked") unless ($isAdministrator); $objDB->MoveFirst; PrintAllRecords($objDB,$activePage); } # --- print the html footer --- print "
"; $objDB->Close; undef($objDB); $objConfig->Close; undef($objConfig); #_____________________________________________________________________________ sub PrintLogin { print "\n"; print "Please login to continue:\n"; print "
\n"; print "
\n"; } #_____________________________________________________________________________ sub PrintAllRecords { my ($objMyDB) = shift || return 0; my ($activePage) = shift || 1; my ($pageSize) = shift || 30; my ($fieldName); my ($count) = 0; my (@fieldNames) = ['Code','Category','Description']; $objMyDB->ActivePage($activePage); my ($pageCount) = $objMyDB->PageCount; print "\n"; #print " | Datum | \n"; #print "Titel | \n"; #print "
"; if ($objMyDB->FieldValue("Private") eq "checked") { print " | \n"; } else { print "\n"; } print "" . FormatDate($objMyDB->FieldValue("Date")) . " | \n"; print "" . $objMyDB->FieldValue("Title") . " | \n"; print "
\n"; print "Seite " . $activePage . " von " . $pageCount; if ($activePage > 1) { print " vorherige"; } if ($activePage < $pageCount) { print " nächste"; } print " (" . $objMyDB->RecordCount . " Eintraege)\n"; print "
\n"; print "
\n"; } #_____________________________________________________________________________ sub PrintCurrentRecord { my ($objMyDb) = shift || return 0; print "\n"; } #_____________________________________________________________________________ sub PrintCurrentRecordReadOnly { my ($objMyDb) = shift || return 0; my ($dataEntry) = $objMyDb->FieldValue("DiaryEntry"); $dataEntry =~ s/\n/Make sure that the file permissions are correct on the configuration file."; print "
Details: " . $objMyDB->LastError; exit 1; }; print "\n"; } #_____________________________________________________________________________ sub UpdateCurrentRecord { my ($objMyDB) = shift; my ($objMyCGI) = shift; $objMyDB->FieldValue("Date",$objMyCGI->param("Date")); $objMyDB->FieldValue("Title",$objMyCGI->param("Title")); $objMyDB->FieldValue("Private",$objMyCGI->param("Private")); $objMyDB->FieldValue("DiaryEntry",$objMyCGI->param("DiaryEntry")); if (!$objMyDB->Commit) { print "An error occured while writing to the data file!"; print "
Make sure that the file permissions are correct on the data file."; print "
Details: " . $objMyDB->LastError; exit 1; }; } #______________________________________________________________________________ sub FormatDate { my ($date) = shift || return 0; my ($mode) = shift || 0; my (@months) = ('','January','February','March','April','May','June','July','August','September','October','November','December'); my (@days) = ('','Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday'); my ($year,$month,$day) = split("\/",$date); return $months[$month] . " " . $day . ", " . $year; } #______________________________________________________________________________ sub GetDate { # version 2.0 # Usage: # &GetDate # returns mm/dd/yyyy # &GetDate(1) # returns mm/dd/yy # &GetDate(2, # returns yy/mm/dd # &GetDate(3) # returns yyyy/mm/dd my ($mode) = shift || 0; my (@months) = ('01','02','03','04','05','06','07','08','09','10','11','12'); my ($sec,$min,$hour,$mday,$mon,$year,$wday) = (localtime(time))[0,1,2,3,4,5,6]; $mday = "0" . $mday if (length($mday) < 2); my $date = ""; $year += 1900; if ($mode == 1) { $year = substr($year,2); $date = "$months[$mon]\/$mday\/$year"; } elsif ($mode == 2) { $year = substr($year,2); $date = "$year\/$months[$mon]\/$mday"; } elsif ($mode == 3) { $date = "$year\/$months[$mon]\/$mday"; } else { # mode = 0 $date = "$months[$mon]\/$mday\/$year"; } return $date; }