summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJonas Smedegaard <dr@jones.dk>2011-10-06 13:35:32 +0200
committerJonas Smedegaard <dr@jones.dk>2011-10-06 13:35:32 +0200
commit9ec00e457a192cdaeddd753617c5b1a8126001ec (patch)
treed4e491a5763ab084ac976081307c9021a54cb43a
parentac255291751e2d635992b5a0ebc4b5f203a888b0 (diff)
Drop a bunch of obsolete scripts.
Diffstat
-rw-r--r--.cvsignore1
-rw-r--r--ChangeLog1254
-rw-r--r--ChangeLog.header11
-rwxr-xr-xipsec-updown-ipmasq198
-rwxr-xr-xlocalmoffycreate78
-rwxr-xr-xlocalmysqloptimize14
-rwxr-xr-xlocalwebbbscreate48
-rwxr-xr-xlocalwebcalcreate55
-rwxr-xr-xwcald3688
9 files changed, 0 insertions, 5347 deletions
diff --git a/.cvsignore b/.cvsignore
deleted file mode 100644
index 8f2c9c4..0000000
--- a/.cvsignore
+++ /dev/null
@@ -1 +0,0 @@
-ChangeLog.bak
diff --git a/ChangeLog b/ChangeLog
deleted file mode 100644
index da26d17..0000000
--- a/ChangeLog
+++ /dev/null
@@ -1,1254 +0,0 @@
-
- ChangeLog for /etc/local/sbin
--=============================-
-
- - All dates/times are in GMT.
- - Generated from cvs log entries
- (cvs2cl --gmt -S --no-wrap --header ChangeLog.header --usermap /etc/local-COMMON/ChangeLog.users)
- - ChangeLog.header file taken from lame CVS.
-
---
-
-2004-12-07 15:53 Jonas Smedegaard <dr@jones.dk>
-
- * deluser.local: Correct removing Samba account with pdbedit.
-
-2004-12-07 15:51 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: Improve workaround for noisy modlogan.
-
-2004-10-20 19:57 Jonas Smedegaard <dr@jones.dk>
-
- * sd2usbguid, usbguid2sd: Add helper tools for automounting USB
- devices
-
-2004-10-10 09:50 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: Quote all variables.
-
-2004-09-25 21:00 Jonas Smedegaard <dr@jones.dk>
-
- * adduser.local: Make samba password optional.
-
-2004-09-09 10:14 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: Let default post_init() fail gracefully.
-
-2004-09-09 09:57 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: Changed analog.conf -> analog.cfg.
-
-2004-09-01 11:54 Jonas Smedegaard <dr@jones.dk>
-
- * localgotallmail: Add new spam-options.
-
-2004-08-26 22:20 Jonas Smedegaard <dr@jones.dk>
-
- * localmysqloptimize: New command localmysqloptimize: Run myisamchk
- on all databases.
-
-2004-08-19 14:40 Jonas Smedegaard <dr@jones.dk>
-
- * localmaildomainprepare, localmaildomainupdate,
- localmkpostfixvirtual: Add wrapper scripts for
- localmkpostfixvirtual.
-
-2004-06-17 01:26 Jonas Smedegaard <dr@jones.dk>
-
- * localmkpostfixvirtual: Do not fail whole script if virtual.addon
- is not found.
-
-2004-06-17 01:21 Jonas Smedegaard <dr@jones.dk>
-
- * localmkpostfixvirtual: Avoid "\n" in sed regex (only handled
- correctly in sed 4.x).
-
-2004-05-13 13:05 Jonas Smedegaard <dr@jones.dk>
-
- * adduser.local, deluser.local: Use pdbedit if present (smbpasswd
- may syncronize with unix password). Similar when deleting (although
- no known problems there).
-
-2004-05-11 11:51 Jonas Smedegaard <dr@jones.dk>
-
- * localwebresolve, localwebstats: Try jdresolve first, before
- attempt DNS lookup.
-
-2004-05-11 11:28 Jonas Smedegaard <dr@jones.dk>
-
- * localwebresolve, localwebstats: Suppress jdresolve record purge
- status unless DEBUG is set.
-
-2004-05-11 10:26 Jonas Smedegaard <dr@jones.dk>
-
- * localwebresolve, localwebstats: Correct double-quoted jdresolve
- db path, and don't check for existing db on record purge.
-
-2004-05-11 10:23 Jonas Smedegaard <dr@jones.dk>
-
- * localwebresolve, localwebstats: Only purge old jdresolve records
- if the db exists.
-
-2004-05-11 10:20 Jonas Smedegaard <dr@jones.dk>
-
- * localwebresolve, localwebstats: Correct test for jdresolve db
- dir.
-
-2004-05-11 10:13 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: Fix jdresolve database use.
-
-2004-05-11 10:07 Jonas Smedegaard <dr@jones.dk>
-
- * localwebresolve: Fix jdresolve database use.
-
-2004-05-07 16:29 Jonas Smedegaard <dr@jones.dk>
-
- * ChangeLog: Update ChangeLog.
-
-2004-05-07 16:26 Jonas Smedegaard <dr@jones.dk>
-
- * localmkpostfixvirtual: Use sed to separate items with newlines
- (tsort is only strictly for _pairs_ of strings - it was a bug that
- it worked earlier).
-
-2004-05-05 18:24 Jonas Smedegaard <dr@jones.dk>
-
- * localmksslcerts: Add a couple of TODO's.
-
-2004-05-04 20:55 Jonas Smedegaard <dr@jones.dk>
-
- * localmksslcerts: Implement generating CA certificate. Yet another
- fix for generating certified host certificates.
-
-2004-05-04 20:30 Jonas Smedegaard <dr@jones.dk>
-
- * localmksslcerts: Fix generating certified host certificates. Fail
- on error.
-
-2004-05-04 19:43 Jonas Smedegaard <dr@jones.dk>
-
- * localmksslcerts: Implement support for generation and use of
- certified host certificates (but not yet generation of CAcert).
-
-2004-04-19 20:50 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: Add automount line only when server_username is set.
-
-2004-04-19 20:48 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: Disable running userlocalconfig (until it can be done
- non-interactively).
-
-2004-04-16 13:24 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: Remove remote server mountpoint creation (automount
- does it automagically).
-
-2004-04-15 22:59 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: Check only if server_userconf is a file (it is
- intentionally not readable globally).
-
-2004-04-15 22:56 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: Cosmetics: new line before invoking localuserconfig.
-
-2004-04-15 22:54 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: remove debug line (early exit).
-
-2004-04-15 22:50 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: Add automount line if not there already, and replace
- if it is.
-
-2004-04-15 22:44 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: Create personal mount points for remote SMB share.
-
-2004-04-15 22:31 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: New code added (interacting with new script
- localuserconfig) for automount access to remote SMB share.
-
-2004-04-15 21:42 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: quote strings, and add a few comments.
-
-2004-03-20 16:38 Jonas Smedegaard <dr@jones.dk>
-
- * localaddmysqldb: Tighten regexp (correctly this time) in grepping
- existing databases, to avoid bailing out when creating new database
- with name being a subset of an exisiting one.
-
-2004-03-20 15:59 Jonas Smedegaard <dr@jones.dk>
-
- * localaddmysqldb: Tighten regexp in grepping existing databases,
- to avoid bailing out when creating new database with name being a
- subset of an exisiting one.
-
-2004-03-04 02:49 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: Improved wording of comment.
-
-2004-02-19 12:37 Jonas Smedegaard <dr@jones.dk>
-
- * adduser.local: Grant local users access to floppies, but refuse
- raw hd access.
-
-2004-02-02 15:24 Jonas Smedegaard <dr@jones.dk>
-
- * adduser.local: Update mailman add_members syntax, and force
- notifications to both user and admin.
-
-2004-01-20 22:39 Jonas Smedegaard <dr@jones.dk>
-
- * localwebsearch: When finished, continue to next item in site
- loop, instead of exiting the whole script.
-
-2003-11-20 15:15 Jonas Smedegaard <dr@jones.dk>
-
- * localdumpsql: Avoid --extended-insert (to ease human
- readability).
-
-2003-11-13 15:34 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: Make sure .my.cnf is readable only by self.
-
-2003-10-20 15:03 Jonas Smedegaard <dr@jones.dk>
-
- * localaddmysqldb: Treat failed db user as a warning only (and in
- fact the failure may be bogus - wwwconfig-common is buggy).
-
-2003-09-12 11:46 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: New subfolder: webshareddata (u=rwX,go=rX) for web
- data shared between accounts).
-
-2003-09-11 17:08 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: change default home subfolders from ',mac', '.pc' and
- '.exchange' to the same without leading dot.
-
-2003-09-08 16:00 Jonas Smedegaard <dr@jones.dk>
-
- * localmkpostfixvirtual: use 'members maildomains' as default
- input, and add usual commands to header.
-
-2003-08-26 23:48 Jonas Smedegaard <dr@jones.dk>
-
- * adduser.local: Add a couple of TODO's.
-
-2003-08-26 14:37 Jonas Smedegaard <dr@jones.dk>
-
- * smbadduser: Remove csh-based smbadduser (smbpasswd -a should work
- just as well).
-
-2003-08-26 14:35 Jonas Smedegaard <dr@jones.dk>
-
- * adduser.local: Avoid local smbadduser (use smbpasswd directly
- instead).
-
-2003-08-14 18:52 Jonas Smedegaard <dr@jones.dk>
-
- * localezcreate: Include extention jpeg in apache rules (in
- addition to jpg).
-
-2003-08-14 16:46 Jonas Smedegaard <dr@jones.dk>
-
- * ChangeLog: Update ChangeLog.
-
-2003-06-28 19:47 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: Be more sloppy when ignoring ModLogAn errors.
-
-2003-06-28 19:32 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: 3rd attempt on sane default post_init.
-
-2003-06-28 19:27 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: Slightly more sane post_init.
-
-2003-06-28 19:18 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: Change to a more generic location of default index
- page master.
-
-2003-06-15 10:26 Jonas Smedegaard <dr@jones.dk>
-
- * localintegritupdate: New script localintegritupdate to run after
- aptitude update.
-
-2003-06-01 16:38 Jonas Smedegaard <dr@jones.dk>
-
- * localdumpsql: Handle empty stamp, and use it when run through
- cron.daily.
-
-2003-06-01 14:22 Jonas Smedegaard <dr@jones.dk>
-
- * userforward: Rename mailspool before forwarding it, to make sure
- noone accidentally works on it simultaneously.
-
-2003-05-27 00:46 Jonas Smedegaard <dr@jones.dk>
-
- * localmkpostfixvirtual: Allow underscore (_) in email account.
-
-2003-05-26 17:09 Jonas Smedegaard <dr@jones.dk>
-
- * localaddmysqldb: Actually do something different in the --ez
- special case.
-
-2003-05-26 16:56 Jonas Smedegaard <dr@jones.dk>
-
- * localaddmysqldb: Correct clashing --force and --ez.
-
-2003-05-26 16:53 Jonas Smedegaard <dr@jones.dk>
-
- * localaddmysqldb: Add special case -z or --ez for eZ Publish
- sites. Add some TODOs.
-
-2003-05-25 11:15 Jonas Smedegaard <dr@jones.dk>
-
- * localgotallmail: Shorten error message a bit.
-
-2003-05-25 03:28 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: Correctly suppres ModLogAn noise.
-
-2003-05-24 11:05 Jonas Smedegaard <dr@jones.dk>
-
- * localgotallmail: Simplify gotmail run a bit.
-
-2003-05-24 11:03 Jonas Smedegaard <dr@jones.dk>
-
- * localgotallmail: Continue batch run even on gotmail errors.
-
-2003-05-22 12:32 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: Improved ModLogAn config and invocation.
-
-2003-05-22 12:27 Jonas Smedegaard <dr@jones.dk>
-
- * localwebresolve: Use /var/log/apache-vhosts by default.
-
-2003-05-22 12:13 Jonas Smedegaard <dr@jones.dk>
-
- * localdumpsql: Set file read-only. Set umask to 277.
-
-2003-05-22 12:06 Jonas Smedegaard <dr@jones.dk>
-
- * localdumpsql: Set dirs read-only.
-
-2003-05-22 12:03 Jonas Smedegaard <dr@jones.dk>
-
- * localdumpsql: Set group ownership.
-
-2003-05-22 12:02 Jonas Smedegaard <dr@jones.dk>
-
- * localdumpsql: Set permissions on each dir instead of recursively.
-
-2003-05-22 11:43 Jonas Smedegaard <dr@jones.dk>
-
- * localdumpsql: Switch back to mkdir, and instead explicitly set
- permissions and ownership (even when not creating the dirs). Quote
- user a few places.
-
-2003-05-22 11:36 Jonas Smedegaard <dr@jones.dk>
-
- * localdumpsql: Use install instead of mkdir to ensure access
- rights also on parent dirs.
-
-2003-05-20 19:25 Jonas Smedegaard <dr@jones.dk>
-
- * localaddmysqldb: Avoid passwords.
-
-2003-05-20 18:05 Jonas Smedegaard <dr@jones.dk>
-
- * localdumpsql: Bugfixing (users and databases not reset between
- database engines.
-
-2003-05-20 03:42 Jonas Smedegaard <dr@jones.dk>
-
- * localdumpsql: Rewrite to dump into backupdir for each database
- owner.
-
-2003-05-20 00:22 Jonas Smedegaard <dr@jones.dk>
-
- * localdumpsql: Avoid messing around with password. Execute MySQL
- commands directly (without pipe).
-
-2003-05-19 23:45 Jonas Smedegaard <dr@jones.dk>
-
- * localaddmysqldb: Allow DELETE for ordinary MySQL accounts.
-
-2003-05-14 10:25 Jonas Smedegaard <dr@jones.dk>
-
- * localezcreate: Fix bug getting maildomain option.
-
-2003-05-12 03:39 Jonas Smedegaard <dr@jones.dk>
-
- * localezcreate, localaddmysqldb: Allow mysql to fail, and use
- mysql instead of mysqladmin.
-
-2003-05-12 03:28 Jonas Smedegaard <dr@jones.dk>
-
- * localaddmysqldb: New script localaddmysqldb.
-
-2003-05-12 03:27 Jonas Smedegaard <dr@jones.dk>
-
- * localezcreate: Add check for existing database.
-
-2003-05-05 09:50 Jonas Smedegaard <dr@jones.dk>
-
- * prim2sec.sh: Make it a sorted list.
-
-2003-05-05 09:44 Jonas Smedegaard <dr@jones.dk>
-
- * prim2sec.sh: Only grab zone lines, and allow all sorts of
- characters in them (if shit is doable in pri it should be passed to
- sec as well).
-
-2003-04-25 04:07 Jonas Smedegaard <dr@jones.dk>
-
- * localezcreate: Use underscores for defaultdbname. Drop dbmatch
- parameter.
-
-2003-03-21 01:17 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: Add workaround for netatalk requiring write access to
- .AppleDB even for read-only access.
-
-2003-03-13 04:47 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: Fix completely ignoed non-exceptions for shares. Set
- toplevel .AppleDouble group r/o.
-
-2003-03-13 03:52 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: Correctly init exceptions.
-
-2003-03-13 03:30 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: Set owner of toplevel dirs of shares. Always run chown
- before chmod (just for consistency).
-
-2003-03-13 03:22 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: Set owner of exceptions always, not only when created.
-
-2003-03-13 03:14 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: Correct owner for exceptions created. Check and
- recreate if exceptions are not of right type. Improve comments.
-
-2003-03-13 02:13 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: Handle new shares.<sharetype> sharing scheme. Support
- space in /root. Echo WARNING when it is not a fatal error.
-
-2003-01-27 15:35 Jonas Smedegaard <dr@jones.dk>
-
- * deluser.local: Use hostname -d as domain part of email adress to
- search for removal (to match change in adduser.local.
-
-2003-01-14 20:50 Jonas Smedegaard <dr@jones.dk>
-
- * adduser.local: /etc/mailname is NOT default maildomain.
-
-2003-01-04 02:24 Jonas Smedegaard <dr@jones.dk>
-
- * localmksslcerts: Add options for remaining certificate
- parameters. Add TODO with hints on true signed certificates using
- openssl. Correct parsing error and help: FQDN cannot be optionally
- prepended (no way to distinguish between FQDN and multiple
- services).
-
-2002-12-30 17:53 Jonas Smedegaard <dr@jones.dk>
-
- * localezcreate: Add new option --dbmatch to support pools of
- webservers accessing same database (could be fun setting up that
- some day).
-
-2002-12-28 16:23 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: Update to ModLogAn 0.8.x configfile syntax.
-
-2002-12-24 19:44 Jonas Smedegaard <dr@jones.dk>
-
- * userforward: Correct syntax error. Allow uid check override by
- force option. Remove hint about force option from error message.
-
-2002-12-24 19:39 Jonas Smedegaard <dr@jones.dk>
-
- * userforward: Forward incoming mailspool if found. Rename
- username variable 'uid' to the more correct 'user'. Check and fail
- if uid of user is below 1000. Standardize error messages.
-
-2002-12-09 00:17 Jonas Smedegaard <dr@jones.dk>
-
- * localezcreate: Add option --debug (showing options set and
- directories used). Finally making setopts function work (renamed
- from setparams). Replace (almost) all && and contructs with
- if-then. Fix default handling of templates, languages and sql.
-
-2002-12-08 18:52 Jonas Smedegaard <dr@jones.dk>
-
- * localezcreate: Tweaks to verbose output. Fix errors parsing
- boolean options. Make non-password input non-silent. Drop database
- silently when force is set and ask is not.
-
-2002-12-08 17:50 Jonas Smedegaard <dr@jones.dk>
-
- * localezcreate: Add short-opts corresponding all long-opts, and
- fix misspelled options. Add flags info and query, and improve logik
- of setting the boolean value. Improve dialog when checking for
- existing installation, and actually respect the force option. Fix
- messy output in tarball and sql loops. Remove last su invocation
- (in the process of making the script work as non-root).
-
-2002-12-08 15:28 Jonas Smedegaard <dr@jones.dk>
-
- * localezcreate: Correct tarball resolving. Make errors within
- parantheses fatal. Improve a few comments.
-
-2002-12-08 15:06 Jonas Smedegaard <dr@jones.dk>
-
- * localezcreate: Even more sane defaults - and opts1-3 moved above
- defaults and better described.
-
-2002-12-08 14:38 Jonas Smedegaard <dr@jones.dk>
-
- * localezcreate: Make sane defaults. Remove unused admindir and
- defaultadmindir.
-
-2002-12-07 18:34 Jonas Smedegaard <dr@jones.dk>
-
- * localezcreate: Use GNU getopt, and make lots of options
- configurable. Redesign help text to look similar to cp help text.
- Generalize initializing options in function setparams. Add options
- --force and --verbose. Add support for overriding with locally
- provided tarballs and sqlfiles.
-
-2002-12-06 23:38 Jonas Smedegaard <dr@jones.dk>
-
- * localezcreate: Make <dbserver> and <dballow> configurable, and
- actually use them. More consistently handle option defaults.
- Comment out unused db drop routine.
-
-2002-12-05 15:04 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: Respect REALUSERS_GROUPNAME not set.
-
-2002-12-05 04:53 Jonas Smedegaard <dr@jones.dk>
-
- * localezcreate: Correctly have <dbuser> default to <uid>.
-
-2002-12-05 04:41 Jonas Smedegaard <dr@jones.dk>
-
- * localezcreate: Rearrange options. Improve layout of help text.
-
-2002-12-05 04:20 Jonas Smedegaard <dr@jones.dk>
-
- * localezcreate: Respect /etc/mailname (but still fallback to
- hostname -d. Make use of wwwconfig-common scripts if available.
- Look for root and user MySQL password in /root/.my.cfg. Install
- locale and template tarballs. Load overrides to defaults from
- /etc/local/localezcreate.conf. Shorten output lines when invoking
- --help. Add demo data as root, not user. Use shell constructs to
- check values, instead of test.
-
-2002-12-03 17:32 Jonas Smedegaard <dr@jones.dk>
-
- * ChangeLog: Update ChangeLog.
-
-2002-11-24 17:17 Jonas Smedegaard <dr@jones.dk>
-
- * localmkpostfixvirtual: localmkpostfixvirtual: Make joker_seen
- local to the domain.
-
-2002-11-23 16:13 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: user-init: Require uid option. webdata folder owned by
- user, not root.
-
-2002-11-14 21:16 Jonas Smedegaard <dr@jones.dk>
-
- * localchastity-update: Add localchastity-update, a support script
- for SquidGuard.
-
-2002-11-08 14:10 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: user-init: No need for others than owner and www-data
- to have access to webphpsites.
-
-2002-11-04 22:43 Jonas Smedegaard <dr@jones.dk>
-
- * localmkpostfixvirtual: Major update:
- * Support for catch-all pseudo-address: +@ or +@mailgroup
- * Correct handling of account being both uid and mailgroup
- * Improved separation of mailgroup owners and other mailgroup
- members (don't take it for granted that mailgroup owner and gid is
- the same).
-
-2002-11-04 22:36 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: Use /var/log/apache-vhosts for vhosts (apache
- crojob dislikes subfolders in /var/log/apache).
-
-2002-11-03 03:06 Jonas Smedegaard <dr@jones.dk>
-
- * localmkpostfixvirtual:
-
- * Rewrite some code as a function
- * Allow "Other"-field to contain mailname@fqdn style hints (in
- addition to mailname@mailgroup ones)
- * Suppress empty-entry warning for mailgroup
-
-2002-10-22 13:59 Juri Jensen <juri@xenux.dk>
-
- * ipsec-updown-ipmasq: Added support for setting up a proper source
- address when f.ex. pinging from the SGW itself. Not a very fine
- solution, but... it works for now.
-
-2002-10-22 03:30 Jonas Smedegaard <dr@jones.dk>
-
- * localezcreate: Add uid and gid to secure_modfix.sh.
-
-2002-10-17 17:23 Jonas Smedegaard <dr@jones.dk>
-
- * localmksslcerts: localmksslcerts: Handle all(?) option variants
- properly, and correct old mail-specific references in comments.
-
-2002-10-17 17:20 Jonas Smedegaard <dr@jones.dk>
-
- * localbackupconfig: localbackupconfig: Let diff fail silently.
-
-2002-10-15 19:13 Jonas Smedegaard <dr@jones.dk>
-
- * localbackupconfig: localbackupconfig: Fail on error.
-
-2002-10-11 14:12 Jonas Smedegaard <dr@jones.dk>
-
- * ChangeLog: Update ChangeLog.
-
-2002-10-06 14:20 Jonas Smedegaard <dr@jones.dk>
-
- * prim2sec.sh: prim2sec.sh: Streamline and, and...
-
-2002-10-04 11:24 Jonas Smedegaard <dr@jones.dk>
-
- * init-mailmanarchive: init-mailmanarchive: mhonarc script moved to
- local-COMMON.
-
-2002-09-22 19:49 Jonas Smedegaard <dr@jones.dk>
-
- * localezcreate: localezcreate: Use tarball tpl instead of install
- (changed in 2.2.7-1), and support wap .wbmp files.
-
-2002-09-19 11:39 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: user-init: Add support for shares_win and shares_mac
- (and remove support for shares_<uid>).
-
-2002-09-12 17:38 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: localwebstats: Update documentation.
-
-2002-09-12 17:34 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: localwebstats: Add documentary header.
-
-2002-09-11 20:33 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: localwebstats works fine without config file:
- Lower from error to warning.
-
-2002-09-09 17:15 Jonas Smedegaard <dr@jones.dk>
-
- * ChangeLog: Update changelog.
-
-2002-09-04 23:35 Jonas Smedegaard <dr@jones.dk>
-
- * localmkpostfixvirtual, user-init: Add support in user-init for
- webphpsites and webphpdata, and tighten access rights on all web*
- dirs.
-
-2002-09-04 09:57 Jonas Smedegaard <dr@jones.dk>
-
- * adduser.local, deluser.local: Use /etc/mailname for mailman
- injections in adduser.local and deluser.local.
-
-2002-09-02 12:26 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: user-init: Correct webdata dir.
-
-2002-09-02 12:24 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: user-init: Add support for webscripts and webdate
- dirs.
-
-2002-08-29 11:18 Jonas Smedegaard <dr@jones.dk>
-
- * ChangeLog, ChangeLog.header: Correct typo.
-
-2002-08-29 11:17 Jonas Smedegaard <dr@jones.dk>
-
- * .cvsignore, ChangeLog, ChangeLog.header: Udate (and improve
- layout of) ChangeLog.
-
-2002-08-16 14:24 Juri Jensen <juri@xenux.dk>
-
- * prim2sec.sh: Initial import. This is a script to convert a
- named.conf include file from a primary nameserver to a file for the
- secondary nameserver. It can only handle it, if the config file
- contains a domain per line.
-
-2002-08-15 09:35 Klaus Agnoletti <klaus@xenux.dk>
-
- * fstab.raid, lilo.conf.raid, mkraid.sh, raidtab:
- * Files added for fully automated creation of RAID system. These
- files should be copied to /etc (except maybe mkraid.sh) to a Debian
- system with RAID kernel support and raidtools2 package installed.
- The source harddrive MUST be /dev/hdb and the two RAID-1 drives
- MUST be /dev/hda and /dev/hdc. The two RAID harddrives MUST be
- partitioned like this : /dev/hda1 and /dev/hdc1 MUST be swap (type
- 82). /dev/hda2 and /dev/hdc2 MUST both de raid-autodetect (type
- fd). After this is done, just run mkraidfs.sh and sit back and
- play a game or two on you PDA if you have one ;-). Mail me for
- questions.
-
-2002-08-14 14:00 Klaus Agnoletti <klaus@xenux.dk>
-
- * fstab.raid, lilo.conf.raid, mkraid.sh, raidtab:
- * Files added for fully automated creation of RAID system. These
- files should be copied to /etc (except maybe mkraid.sh) to a Debian
- system with RAID kernel support and raidtools2 package installed.
- The source harddrive MUST be /dev/hdb and the two RAID-1 drives
- MUST be /dev/hda and /dev/hdc. The two RAID harddrives MUST be
- partitioned like this : /dev/hda1 and /dev/hdc1 MUST be swap (type
- 82). /dev/hda2 and /dev/hdc2 MUST both de raid-autodetect (type
- fd). After this is done, just run mkraidfs.sh and sit back and
- play a game or two on you PDA if you have one :-). Mail me for
- questions.
-
-2002-08-08 16:20 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: user-init: Support $HOME/websites/* style web
- hierarchy.
-
-2002-08-01 19:02 Jonas Smedegaard <dr@jones.dk>
-
- * ChangeLog: Updage ChangeLog.
-
-2002-07-20 18:40 Jonas Smedegaard <dr@jones.dk>
-
- * localmkpostfixvirtual: localmkpostfixvirtual: *Really* make
- fallback...
-
-2002-07-20 18:30 Jonas Smedegaard <dr@jones.dk>
-
- * localmkpostfixvirtual, localwebstats: localmkpostfixvirtual:
- fallback to single mailgroup if roomnumber empty. Update docs.
-
-2002-06-17 09:46 Jonas Smedegaard <dr@jones.dk>
-
- * localezcreate: eZ Publish needs more privileges.
-
-2002-05-30 20:52 Juri Jensen <juri@xenux.dk>
-
- * ipsec-updown-ipmasq: Added ipsec-updown-ipmasq.
-
-2002-05-25 02:02 Jonas Smedegaard <dr@jones.dk>
-
- * localgotallmail: Fix ----option generosity bug.
-
-2002-05-13 11:08 Jonas Smedegaard <dr@jones.dk>
-
- * adduser.local: Correct mailforwarding in adduser.local.
-
-2002-04-24 01:35 Jonas Smedegaard <dr@jones.dk>
-
- * localgotallmail: More elegant galant...
-
-2002-04-24 01:04 Jonas Smedegaard <dr@jones.dk>
-
- * localgotallmail: New script: localgotallmail.
-
-2002-04-24 00:05 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: Reuse a getent.
-
-2002-04-23 23:50 Jonas Smedegaard <dr@jones.dk>
-
- * localwebresolve: Remove comment about cron.
-
-2002-04-10 01:12 Jonas Smedegaard <dr@jones.dk>
-
- * localezcreate: localezcreate: Expect eZ tarballs to be in
- /usr/src/ezpublish.
-
-2002-04-10 00:39 Jonas Smedegaard <dr@jones.dk>
-
- * localezcreate: Don't run clearcache in localezcreate.
-
-2002-04-09 23:32 Jonas Smedegaard <dr@jones.dk>
-
- * localezcreate: Use vhosts.d (instead of vhosts) as Apache config
- subdir in localezcreate.
-
-2002-04-09 23:04 Jonas Smedegaard <dr@jones.dk>
-
- * localezcreate: Remove old commented out code from localezcreate.
-
-2002-04-02 07:16 Jonas Smedegaard <dr@jones.dk>
-
- * deluser.local: Fix mailinglist handling in deluser.local.
-
-2002-03-30 02:54 Jonas Smedegaard <dr@jones.dk>
-
- * adduser.local, user-init: Ask about access to local devices in
- adduser.local, and exit user-init cleanly if unsupported.
-
-2002-03-29 18:31 Jonas Smedegaard <dr@jones.dk>
-
- * localmksslcerts: Fix using opts twice.
-
-2002-03-29 17:40 Jonas Smedegaard <dr@jones.dk>
-
- * localmksslcerts: Correct logic once more (and it _works_ this
- time...!)
-
-2002-03-29 17:36 Jonas Smedegaard <dr@jones.dk>
-
- * localmksslcerts: Correct logic of parameter parsing (and BTW -
- last commit also included fix for actually generating the cert when
- force removing the old one).
-
-2002-03-29 17:34 Jonas Smedegaard <dr@jones.dk>
-
- * localmksslcerts: Improve parameter parsing and remove short
- options requiring a parameter.
-
-2002-03-29 13:43 Jonas Smedegaard <dr@jones.dk>
-
- * localbackupconfig: Handle .bak as well.
-
-2002-03-29 13:33 Jonas Smedegaard <dr@jones.dk>
-
- * localbackupconfig: Remove localrmtoobig stuff (ooops!). Handle
- /etc/local-$FQDN. Really handle .orig items also. Use dirname to
- make sure we use the correct directory (instead of an extra
- directory with the samen name below).
-
-2002-03-29 12:59 Jonas Smedegaard <dr@jones.dk>
-
- * localbackupconfig: Backup both .dpkg-new, .old and .orig style
- config differences - and document the difference.
-
-2002-03-29 01:11 Jonas Smedegaard <dr@jones.dk>
-
- * localmksslcerts: -h is help. And improve help text.
-
-2002-03-29 01:04 Jonas Smedegaard <dr@jones.dk>
-
- * localmkmailcerts, localmksslcerts: Rename localmkmailcerts to
- localmksslcerts. Major rewrite.
-
-2002-03-28 15:46 Jonas Smedegaard <dr@jones.dk>
-
- * deluser.local: Be as generic in deluser.local as in adduser.local
- regarding mailinglists.
-
-2002-03-25 15:52 Jonas Smedegaard <dr@jones.dk>
-
- * localbackupconfig: New script localbackupconfig.
-
-2002-03-18 20:25 Jonas Smedegaard <dr@jones.dk>
-
- * localwebsearch: Move lockfile routines closer to where it is
- actually needed in localwebsearch - and disable it, as it doesn't
- work currently :-(
-
-2002-03-18 20:12 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: Suppres all output from ModLogAn (can't seem to
- find other ways to guiet down the program).
-
-2002-03-14 15:36 Jonas Smedegaard <dr@jones.dk>
-
- * ChangeLog: Update changelog.
-
-2002-03-14 15:28 Jonas Smedegaard <dr@jones.dk>
-
- * adduser.local: Fix bug: adduser.local would _always_ add user to
- users, not other lists.
-
-2002-03-14 14:40 Jonas Smedegaard <dr@jones.dk>
-
- * showlog: Add websuexec swolog option and interpret weberrors like
- weberror.
-
-2002-03-14 12:15 Jonas Smedegaard <dr@jones.dk>
-
- * localusermailaddr, user-mailaddr: Revert the rename of
- user-mailaddr - to avoid the need of explaining to sudoers the
- difference between official debian stuff and local hacks (which is
- the reason for the prepending local*).
-
-2002-03-11 14:15 Jonas Smedegaard <dr@jones.dk>
-
- * localusermailaddr, user-mailadr: Rename user/mailadr to
- localusermailaddr and add comment.
-
-2002-03-09 20:41 Jonas Smedegaard <dr@jones.dk>
-
- * localrmtoobig, rm-toobig: rename rm-toobig to localrmtoobig and
- add comments.
-
-2002-03-07 20:33 Jonas Smedegaard <dr@jones.dk>
-
- * deluser.local: deluser.local: Stricten check for removing home
- (fatal error!!!).
-
-2002-03-07 16:22 Jonas Smedegaard <dr@jones.dk>
-
- * adduser.local, aptdpkgclean, aptdpkgclean.sh, aptdpkgro,
- aptdpkgro.sh, deluser.local, faxrcvd, faxrcvd-mail,
- init-mailmanarchive, localdumpsql, localezcreate,
- localmkmailcerts, localmkpostfixvirtual, localmoffycreate,
- localrundig, localwebbbscreate, localwebcalcreate,
- localwebresolve, localwebsearch, localwebstats, mkmailcerts,
- showlog: Rename files and add/improve descriptive headers.
-
-2002-03-07 15:28 Jonas Smedegaard <dr@jones.dk>
-
- * adduser.local: Add comment for adduser.local.
-
-2002-03-07 15:18 Jonas Smedegaard <dr@jones.dk>
-
- * ChangeLog, ChangeLog.header: Add ChangeLog.
-
-2002-03-05 02:25 Jonas Smedegaard <dr@jones.dk>
-
- * localmkpostfixvirtual: localmkpostfixvirtual: Alow dash ("-") in
- email domainpart as well. Look for localpart hints in root account.
-
-2002-03-05 02:06 Jonas Smedegaard <dr@jones.dk>
-
- * localmkpostfixvirtual: localmkpostfixvirtual: Alow dash ("-") in
- email localpart.
-
-2002-02-28 17:27 Jonas Smedegaard <dr@jones.dk>
-
- * localwebresolve: Add new script localwebresolve as a companion to
- localwebstats.
-
-2002-02-28 14:57 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: localwebstats: Correct ModLogAn options.
-
-2002-02-28 14:41 Jonas Smedegaard <dr@jones.dk>
-
- * whois-dk: Move whois-dk to bin.
-
-2002-02-25 18:30 Jonas Smedegaard <dr@jones.dk>
-
- * showlog: showlog: Add option system.
-
-2002-02-25 04:29 Jonas Smedegaard <dr@jones.dk>
-
- * adduser.local, deluser.local, user-init: A few more tweaks and
- corrections to adduser.local, deluser.local and user-init.
-
-2002-02-24 14:34 Jonas Smedegaard <dr@jones.dk>
-
- * deluser.local: deluser.local: Corrections to removing home dir.
-
-2002-02-24 01:21 Jonas Smedegaard <dr@jones.dk>
-
- * adduser.local, deluser.local, user-init: A few more tweaks and
- corrections to adduser.local, deluser.local and user-init.
-
-2002-02-24 00:17 Jonas Smedegaard <dr@jones.dk>
-
- * deluser.local: deluser.local: Another small (but important)
- correction.
-
-2002-02-24 00:16 Jonas Smedegaard <dr@jones.dk>
-
- * deluser.local: adduser.local and deluser.local: Small (but
- important) corrections.
-
-2002-02-24 00:11 Jonas Smedegaard <dr@jones.dk>
-
- * adduser.local, deluser.local: adduser.local and deluser.local:
- Improve support for mailinglists and samba passwords, and add
- (non-generic) support for environments with dummy/real users.
-
-2002-02-22 19:46 Jonas Smedegaard <dr@jones.dk>
-
- * showlog: showlog: Remove support (and need) for config file -
- there's no user servicable parts inside....
-
-2002-02-22 19:43 Jonas Smedegaard <dr@jones.dk>
-
- * showlog: showlog: New command to list logfiles with simple
- options (targeted at local admins).
-
-2002-02-22 17:45 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: user-init: Improvements and corrections to web_*,
- ftp_* and mac_* shares (and lock TrashCan again - it still doesn't
- work correctly in netatalk).
-
-2002-02-21 06:17 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: user-init: _Really_ let everybody read dirs in private
- ftp_* dirs.
-
-2002-02-21 06:15 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: user-init: Let everybody read dirs in private ftp_*
- dirs.
-
-2002-02-21 06:12 Jonas Smedegaard <dr@jones.dk>
-
- * user-init: user-init: Add support for private ftp_* dirs.
-
-2002-02-18 03:17 Jonas Smedegaard <dr@jones.dk>
-
- * localdumpsql: localdumpsql: Make sure not only postgresql-client
- is installed before looking for databases.
-
-2002-02-11 03:59 Jonas Smedegaard <dr@jones.dk>
-
- * userforward: userforward: Mention force option when backing out.
-
-2002-02-11 03:45 Jonas Smedegaard <dr@jones.dk>
-
- * userforward: userforward: Add force option.
-
-2002-02-11 03:38 Jonas Smedegaard <dr@jones.dk>
-
- * localmkpostfixvirtual: localmkpostfixvirtual: Print the real
- groups instead of what is maybe noted as roomnumber hints.
-
-2002-02-11 02:50 Jonas Smedegaard <dr@jones.dk>
-
- * localezcreate: tar needs to be executed from a readable
- directory, even if target dir is set (found out when running from
- /root).localezcreate
-
-2002-02-05 13:12 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: Misc updates tp localwebstats.
-
-2002-01-27 23:33 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: Add ModLogAn support. Sort log lists (what a
- bummer!).
-
-2002-01-27 22:44 Jonas Smedegaard <dr@jones.dk>
-
- * htdig-init, htdig-init-all, htdig-run, htdig-run-all,
- localwebsearch: Major overhaul of localwebsearch:
- - Remove unused run-mode options.
- - Added run-mode "initprep" that marks next run as a full run
- (inspired by new design of htdig cron routines).
- - Properly structure run-modes, and use individual lockfiles for
- each WEBDIR.
- - Remove leftover stuff from localwebstats.
-
-2002-01-27 22:37 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: Small tweaks to localwebstats:
- - Include configfile path in error when config can't be loaded.
- - More DEBUG status messages.
- - Small cleanups here and there.
-
-2002-01-27 22:33 Jonas Smedegaard <dr@jones.dk>
-
- * localrundig: Misc. bugfixes and tweaks to localrundig:
- - Be less strict on filename characters.
- - Remove debug mess.
- - Use LOCALDBDIR consistently (prepare for passing on to upstream
- by simply s/(LOCAL|local)//.
- - Separate static and semi-static (generate-once) language files
- from db files.
-
-2002-01-27 07:48 Jonas Smedegaard <dr@jones.dk>
-
- * aptdpkgclean.sh: Only deregister found files (filenames sometimes
- change from old to new package).
-
-2002-01-27 07:34 Jonas Smedegaard <dr@jones.dk>
-
- * aptdpkgro.sh: Only register files once (on interrupted installs
- same files are possibly installed multiple times).
-
-2002-01-25 16:30 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats-all, whois-dk: Delete localwebstats-all, Add
- whois-dk.
-
-2002-01-24 17:03 Jonas Smedegaard <dr@jones.dk>
-
- * localmkpostfixvirtual, vpopmail2postfixvirtual: Re-rename badly
- renamed vpopmail2postfixvirtual to localmkpostfixvirtual.
-
-2002-01-23 03:22 Jonas Smedegaard <dr@jones.dk>
-
- * localezcreate: Correct (and comment out for now) ezpasswd entry.
- Correct parameter limit check. Add example to usage.
-
-2002-01-23 03:10 Jonas Smedegaard <dr@jones.dk>
-
- * localezcreate: Bring localezcreate up-to-date with ezpublish
- 2.2.3-0.0.1. Correct apache config. Correct usage output.
-
-2002-01-21 04:06 Jonas Smedegaard <dr@jones.dk>
-
- * localrundig, localwebsearch: Changes to localrundig and begin
- work on localwebsearch (works from cron only).
-
-2002-01-21 00:18 Jonas Smedegaard <dr@jones.dk>
-
- * localrundig: Add localrundig (copy of rundig from htdig
- 3.1.6-0.snapshot011118).
-
-2002-01-17 17:09 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: localwebstats: use find instead of ls (no
- complaints with empty result).
-
-2002-01-14 12:57 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: Several changes to localwebstats:
- - Exit on error.
- - Have all functions equally expect options LOGROOT, WEBROOT and
- WEBSITE (in that order).
- - Don't exit on empty LOGDATARESOLVED.
- - Add hooks for functions pre_init, pre_update, post_init and
- post_update.
- - Remove last traces of logfiles, logfilesgz, logfilesresolved and
- logfilesresolvedgz functions.
- - Corrections to webdirs function.
-
-2002-01-09 21:50 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: localwebstats: Put AWStats cache files in
- STATSDIR, so it is purged on init.
-
-2002-01-09 21:17 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: localwebstats: Ooops - forgot to remove debug
- mess.
-
-2002-01-09 21:15 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: localwebstats updates:
- - CACHEFILE option before LOGDATA option (probably makes no
- difference, but better be safe than sorry).
- - set LANGUAGE ENGLISH on rmagic update (not only init).
-
-2002-01-09 17:53 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: localwebstats updates:
- - Add support for Report Magic (in english...).
- - Force overwrite of LOGDATA gzip'ing.
-
-2002-01-09 01:47 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: localwebstats: gzip LOGDATA after use. Have
- AWStats use LOGDATATMP as much as possible.
-
-2002-01-09 01:40 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: Several updates to localwebstats:
- - Include *.local config files on init. Remove option reset.
- - Improve webdirs() function.
- - Add logcontent* functions and reorder logfile* functions to
- reflect the order they are used.
- - Rename LOGDATA* output filenames to be more obvious.
- - Make sure output is generated even if last pool of data is
- empty.
- - Avoid using DB features of jdresolve - they are broken currently,
- it seems.
-
-2002-01-04 23:57 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: Major overhaul of localwebstats:
- * Correctly split reset and update runs.
- * Improve awstats defaults.
- * Make sure all LOGDATA files are (at least) touched before use.
- * Remove double -Q Webalizer option.
- * Added option "init" that does a reset and overwrites config
- files to default values.
- * Replace inline `cmd` commands with the (as I understand it)
- newer $(cmd) variant.
- * Replace ${var} with the simpler $var.
- * Replace == tests with sh-compliant =.
- * Add variable STATSDIR and remove WEBDIR.
- * Put all binaries as variables in top of script (but below
- configurable ones).
- * No longer make symlinks into website (doesn't work well, and I
- have switched to using a separate stats website instead).
-
-2002-01-04 13:51 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: Spit out reason when exiting, add new hints
- LOGFILESRESOLVED and LOGFILESRESOLVEDGZ, and support empty output of
- logfile hints
-
-2002-01-04 11:54 Jonas Smedegaard <dr@jones.dk>
-
- * localwebstats: localwebstats: Add another debug message.
-
-2002-01-02 05:24 Jonas Smedegaard <dr@jones.dk>
-
- * volinit-netatalk: quote output of getent.
-
-2001-12-13 17:00 Jonas Smedegaard <dr@jones.dk>
-
- * volinit-netatalk: volinit-netatalk: Improve uid check and
- fallback to default user and group.
-
-2001-12-13 16:20 Jonas Smedegaard <dr@jones.dk>
-
- * volinit-netatalk: Cleanup of volinit-netatalk: + Support uid's
- containing dots (use ":" instead of "." in chown commands). + Add
- description. + Remove old commented out lines.
-
-2001-12-13 16:08 Jonas Smedegaard <dr@jones.dk>
-
- * volinit-netatalk: Keep uid when resetting all files (nice to have
- to locate the responsible person for a file).
-
-2001-12-12 19:52 Jonas Smedegaard <dr@jones.dk>
-
- * adduser.local, deluser.local, localmoffycreate,
- localwebbbscreate, localwebcalcreate, localwebstats,
- localwebstats-all, mkmailcerts, rm-toobig, smbadduser,
- usergroupinfo, vpopmail2postfixvirtual, user-init, userforward,
- usergroupadd, volinit-netatalk, volinit-public, volinit-samba,
- volinit-std-all, volinit-xchange, webuser-refresh-all, faxrcvd,
- htdig-init, htdig-init-all, htdig-run, htdig-run-all,
- init-mailmanarchive, user-mailadr, wcald, webuser,
- aptdpkgclean.sh, aptdpkgro.sh, faxrcvd-mail, localdumpsql,
- localezcreate: /usr/local/sbin initial import
-
-2001-12-12 19:52 Jonas Smedegaard <dr@jones.dk>
-
- * adduser.local, deluser.local, localmoffycreate,
- localwebbbscreate, localwebcalcreate, localwebstats,
- localwebstats-all, mkmailcerts, rm-toobig, smbadduser,
- usergroupinfo, vpopmail2postfixvirtual, user-init, userforward,
- usergroupadd, volinit-netatalk, volinit-public, volinit-samba,
- volinit-std-all, volinit-xchange, webuser-refresh-all, faxrcvd,
- htdig-init, htdig-init-all, htdig-run, htdig-run-all,
- init-mailmanarchive, user-mailadr, wcald, webuser,
- aptdpkgclean.sh, aptdpkgro.sh, faxrcvd-mail, localdumpsql,
- localezcreate: Initial revision
-
diff --git a/ChangeLog.header b/ChangeLog.header
deleted file mode 100644
index 585f084..0000000
--- a/ChangeLog.header
+++ /dev/null
@@ -1,11 +0,0 @@
-
- ChangeLog for /etc/local/sbin
--=============================-
-
- - All dates/times are in GMT.
- - Generated from cvs log entries
- (cvs2cl --gmt --fsf --header ChangeLog.header --usermap /etc/local-COMMON/ChangeLog.users)
- - ChangeLog.header file taken from lame CVS.
-
---
-
diff --git a/ipsec-updown-ipmasq b/ipsec-updown-ipmasq
deleted file mode 100755
index 53093a8..0000000
--- a/ipsec-updown-ipmasq
+++ /dev/null
@@ -1,198 +0,0 @@
-#! /bin/sh
-# default updown script
-# Copyright (C) 2000, 2001 D. Hugh Redelmeier, Henry Spencer
-#
-# This program is free software; you can redistribute it and/or modify it
-# under the terms of the GNU General Public License as published by the
-# Free Software Foundation; either version 2 of the License, or (at your
-# option) any later version. See <http://www.fsf.org/copyleft/gpl.txt>.
-#
-# 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.
-
-
-# This script is a derivative of the one by Hugh Redelmeier and Henry
-# Spencer. It uses ipmasq as the firewallscript, and should be used
-# together with some modifications to ipmasq.
-#
-# It is modified by Jonas Smedegaard <jonas@jones.dk>, and Juri Jensen
-# <juri@xenux.dk>.
-#
-# Features:
-#
-# * Dynamic creation of firewall rules to RW connections
-# * Setup of proper source address makes it possible to ping from the
-# SGW itself to a remote subnet, without a separate tunnel. Remember
-# to change the reference of a 10.0.x.x network below to the IP range
-# you're using!
-#
-# RCSID $Id: ipsec-updown-ipmasq,v 1.3 2006-07-16 12:34:00 jonas Exp $
-
-
-# CAUTION: Installing a new version of FreeS/WAN will install a new
-# copy of this script, wiping out any custom changes you make. If
-# you need changes, make a copy of this under another name, and customize
-# that, and use the (left/right)updown parameters in ipsec.conf to make
-# FreeS/WAN use yours instead of this default one.
-
-
-
-# check interface version
-case "$PLUTO_VERSION" in
-1.[0]) # Older Pluto?!? Play it safe, script may be using new features.
- echo "$0: obsolete interface version \`$PLUTO_VERSION'," >&2
- echo "$0: called by obsolete Pluto?" >&2
- exit 2
- ;;
-1.*) ;;
-*) echo "$0: unknown interface version \`$PLUTO_VERSION'" >&2
- exit 2
- ;;
-esac
-
-# check parameter(s)
-case "$1:$*" in
-':') # no parameters
- ;;
-ipfwadm:ipfwadm) # due to (left/right)firewall; for default script only
- ;;
-custom:*) # custom parameters (see above CAUTION comment)
- ;;
-*) echo "$0: unknown parameters \`$*'" >&2
- exit 2
- ;;
-esac
-
-# utility functions for route manipulation
-# Meddling with this stuff should not be necessary and requires great care.
-uproute() {
- doroute add
-}
-downroute() {
- doroute del
-}
-doroute() {
- parms="-net $PLUTO_PEER_CLIENT_NET netmask $PLUTO_PEER_CLIENT_MASK"
- parms2="dev $PLUTO_INTERFACE gw $PLUTO_NEXT_HOP"
- case "$PLUTO_PEER_CLIENT_NET/$PLUTO_PEER_CLIENT_MASK" in
- "0.0.0.0/0.0.0.0")
- # horrible kludge for obscure routing bug with opportunistic
- it="route $1 -net 0.0.0.0 netmask 128.0.0.0 $parms2 &&"
- it="$it route $1 -net 128.0.0.0 netmask 128.0.0.0 $parms2"
- route $1 -net 0.0.0.0 netmask 128.0.0.0 $parms2 &&
- route $1 -net 128.0.0.0 netmask 128.0.0.0 $parms2
- ;;
- *) it="route $1 $parms $parms2"
- route $1 $parms $parms2
- ;;
- esac
- st=$?
- src="`ifconfig | egrep "^[[:space:]]*inet addr:10\.0\." | cut -f2 -d: | cut -f1 -d' ' | head -n 1`"
- if test "$src" ; then
- ip ro ls | egrep "^10\.0\..* dev ipsec" | egrep -v " src " |
- while read ; do
- ip ro change $REPLY src $src
- done
- fi
- if test $st -ne 0
- then
- # route has already given its own cryptic message
- echo "$0: \`$it' failed" >&2
- if test " $1 $st" = " add 7"
- then
- # another totally undocumented interface -- 7 and
- # "SIOCADDRT: Network is unreachable" means that
- # the gateway isn't reachable.
- echo "$0: (incorrect or missing nexthop setting??)" >&2
- fi
- fi
- return $st
-}
-
-
-
-# the big choice
-case "$PLUTO_VERB:$1" in
-prepare-host:*|prepare-client:*)
- # delete possibly-existing route (preliminary to adding a route)
- case "$PLUTO_PEER_CLIENT_NET/$PLUTO_PEER_CLIENT_MASK" in
- "0.0.0.0/0.0.0.0")
- # horrible kludge for obscure routing bug with opportunistic
- parms1="-net 0.0.0.0 netmask 128.0.0.0"
- parms2="-net 128.0.0.0 netmask 128.0.0.0"
- it="route del $parms1 2>&1 ; route del $parms2 2>&1"
- oops="`route del $parms1 2>&1 ; route del $parms2 2>&1`"
- ;;
- *)
- parms="-net $PLUTO_PEER_CLIENT_NET netmask $PLUTO_PEER_CLIENT_MASK"
- it="route del $parms 2>&1"
- oops="`route del $parms 2>&1`"
- ;;
- esac
- status="$?"
- if test " $oops" = " " -a " $status" != " 0"
- then
- oops="silent error, exit status $status"
- fi
- case "$oops" in
- 'SIOCDELRT: No such process'*)
- # This is what route (currently -- not documented!) gives
- # for "could not find such a route".
- oops=
- status=0
- ;;
- esac
- if test " $oops" != " " -o " $status" != " 0"
- then
- echo "$0: \`$it' failed ($oops)" >&2
- fi
- exit $status
- ;;
-route-host:*|route-client:*)
- # connection to me or my client subnet being routed
- uproute
- ;;
-unroute-host:*|unroute-client:*)
- # connection to me or my client subnet being unrouted
- downroute
- ;;
-up-host:*)
- # connection to me coming up
- # If you are doing a custom version, firewall commands go here.
- /usr/sbin/ipmasq
- ;;
-down-host:*)
- # connection to me going down
- # If you are doing a custom version, firewall commands go here.
- /usr/sbin/ipmasq
- ;;
-up-client:)
- # connection to my client subnet coming up
- # If you are doing a custom version, firewall commands go here.
- /usr/sbin/ipmasq
- ;;
-down-client:)
- # connection to my client subnet going down
- # If you are doing a custom version, firewall commands go here.
- /usr/sbin/ipmasq
- ;;
-up-client:ipfwadm)
- # connection to client subnet, with (left/right)firewall=yes, coming up
- # This is used only by the default updown script, not by your custom
- # ones, so do not mess with it; see CAUTION comment up at top.
- ipfwadm -F -i accept -b -S $PLUTO_MY_CLIENT_NET/$PLUTO_MY_CLIENT_MASK \
- -D $PLUTO_PEER_CLIENT_NET/$PLUTO_PEER_CLIENT_MASK
- ;;
-down-client:ipfwadm)
- # connection to client subnet, with (left/right)firewall=yes, going down
- # This is used only by the default updown script, not by your custom
- # ones, so do not mess with it; see CAUTION comment up at top.
- ipfwadm -F -d accept -b -S $PLUTO_MY_CLIENT_NET/$PLUTO_MY_CLIENT_MASK \
- -D $PLUTO_PEER_CLIENT_NET/$PLUTO_PEER_CLIENT_MASK
- ;;
-*) echo "$0: unknown verb \`$PLUTO_VERB' or parameter \`$1'" >&2
- exit 1
- ;;
-esac
diff --git a/localmoffycreate b/localmoffycreate
deleted file mode 100755
index 50fffbe..0000000
--- a/localmoffycreate
+++ /dev/null
@@ -1,78 +0,0 @@
-#!/bin/bash
-#
-# /usr/local/sbin/localmoffycreate
-# Copyright 2001 Jonas Smedegaard <dr@jones.dk>
-#
-# $Id: localmoffycreate,v 1.2 2002-03-07 16:22:51 jonas Exp $
-#
-# Create local Moffy website
-#
-
-set -e
-
-user="moffy"
-passwd="oscerciv"
-db="moffy"
-
-mysqladmin -uroot -p create $db
-echo "GRANT ALL ON $db.* TO '$user@localhost' IDENTIFIED BY '$passwd' WITH GRANT OPTION;" | mysql -uroot -p
-
-#mysql -u$user -p$passwd $db < $basedir/sql/publish.sql
-dbstring="INSERT INTO eZUser_User VALUES (1,'$user',password('$passwd'),'$user@$domain','admin','user','false','',0,0);"
-cat $basedir/sql/publish.sql | sed "s/^INSERT INTO eZUser_User VALUES.*\$/$dbstring/" | mysql -u$user -p$passwd $db
-su $user -c "zcat $basedir/data.tar.gz | tar -xv -C $basedir"
-mysql -u$user -p$passwd $db < $basedir/sql/data.sql
-
-#su $user -c "cd $basedir && ./modfix.sh"
-#su $user -c "cd $basedir && ./secure_clearcache.sh"
-#su $user -c "echo \"
-#RewriteEngine On
-#RewriteRule ^/stats/store/(.*).gif\\\$ $basedir/ezstats/user/storestats.php [S=2]
-#RewriteRule ^/filemanager/filedownload/([^/]+)/(.*)\\\$ $basedir/ezfilemanager/files/\\\$1 [T=\\\"application/oct-stream\\\",S=1]
-#RewriteRule \!\.(gif|css|jpg|png)\\\$ $basedir/index.php
-#\" > $basedir/.htaccess"
-
-#su $user -c "echo \"
-#RewriteEngine On
-#RewriteRule \!\.(gif|css|jpg|png)\\\$ $basedir/index_admin.php
-#\" > $adminbasedir/.htaccess"
-
-su $user -c "
- cd $basedir
- ./modfix.sh
- ./secure_modfix.sh $user $group
- ./clearcache.sh
- ./secure_clearcache.sh
- cat site.ini | sed 's/^SiteURL=publish.ez.no\$/SiteURL=$host/' > site.ini.tmp && mv site.ini.tmp site.ini
- cat site.ini | sed 's/^Database=publish\$/Database=$db/' > site.ini.tmp && mv site.ini.tmp site.ini
- cat site.ini | sed 's/^User=publish\$/User=$user/' > site.ini.tmp && mv site.ini.tmp site.ini
- cat site.ini | sed 's/^Password=publish\$/Password=$passwd/' > site.ini.tmp && mv site.ini.tmp site.ini
- cat site.ini | sed 's/^Database=publish\$/Database=$db/' > site.ini.tmp && mv site.ini.tmp site.ini
-"
-
-echo "
-<VirtualHost *>
- ServerName $host
- ServerAdmin $user@$domain
- DocumentRoot $basedir
- user $user
- group $group
- php_flag magic_quotes_gpc off
- RewriteEngine On
- RewriteRule ^/stats/store/(.*).gif\$ $basedir/ezstats/user/storestats.php [S=2]
- RewriteRule ^/filemanager/filedownload/([^/]+)/(.*)\$ $basedir/ezfilemanager/files/\$1 [T="application/oct-stream",S=1]
- RewriteRule !\.(gif|css|jpg|png)\$ $basedir/index.php
-</VirtualHost>
-<VirtualHost *>
- ServerName $adminhost
- ServerAdmin $user@$domain
- DocumentRoot $basedir
- user $user
- group $group
- php_flag magic_quotes_gpc off
- RewriteEngine On
- RewriteRule !\.(gif|css|jpg|png)\$ $basedir/index_admin.php
-</VirtualHost>
-" > $webcfg
-
-echo "Remember to reload Apache..."
diff --git a/localmysqloptimize b/localmysqloptimize
deleted file mode 100755
index f18027b..0000000
--- a/localmysqloptimize
+++ /dev/null
@@ -1,14 +0,0 @@
-#!/bin/bash
-#
-# /usr/local/sbin/localmysqloptimize
-# Copyright 2004 Jonas Smedegaard <dr@jones.dk>
-#
-# $Id: localmysqloptimize,v 1.1 2004-08-26 22:20:37 jonas Exp $
-#
-# MySQL maintenance script
-#
-
-# halt on errors
-set -e
-
-find /var/lib/mysql -type f -regex '.*\.MYI' -exec myisamchk -r --sort-index --analyze -s {} ';'
diff --git a/localwebbbscreate b/localwebbbscreate
deleted file mode 100755
index 26059ac..0000000
--- a/localwebbbscreate
+++ /dev/null
@@ -1,48 +0,0 @@
-#!/bin/sh
-#
-# /usr/local/sbin/localwebbbscreate
-# Copyright 2001 Jonas Smedegaard <dr@jones.dk>
-#
-# $Id: localwebbbscreate,v 1.2 2002-03-07 16:22:51 jonas Exp $
-#
-# Create local webbbs
-#
-
-NAME=webbbs
-PATH=$PATH:/usr/local/sbin
-USER=$2
-BBS=$3
-HOME=/web/$USER
-CGI=$HOME/www/cgi-local
-
-test "x$USER" = "x" && $1=""
-
-case "$1" in
- add)
- test "x$BBS" = "x" && exit 1
- echo -n "Adding bbs $BBS to webserver $USER: "
- test -d $HOME/webbbs || mkdir $HOME/webbbs
- mkdir $HOME/webbbs/$BBS
- test -d $CGI || mkdir $CGI
- chown $USER.www-data $CGI
- cp /usr/local/lib/scripts/darryl/webbbs/config.pl $CGI/$BBS.cgi
- chown $USER.www-data $CGI/$BBS.cgi
- chown -R $USER.www-data $HOME/webbbs
- chmod g+w $HOME/webbbs/$BBS
- chmod g+x,o= $CGI/$BBS.cgi
- echo "Done!"
- ;;
- del|delete|remove)
- test -d $HOME/webbbs/$BBS || exit 1
- echo -n "Deleting bbs $BBS from webserver $USER: "
- rm -rf $HOME/webbbs/$BBS
- rm -rf $CGI/$BBS.cgi
- echo "Done!"
- ;;
- *)
- echo "Usage: $NAME [ add | delete ] WEBSERVER BBS"
- exit 1
- ;;
-esac
-
-exit 0
diff --git a/localwebcalcreate b/localwebcalcreate
deleted file mode 100755
index c97b673..0000000
--- a/localwebcalcreate
+++ /dev/null
@@ -1,55 +0,0 @@
-#!/bin/sh
-#
-# /usr/local/sbin/localwebcalcreate
-# Copyright 2001 Jonas Smedegaard <dr@jones.dk>
-#
-# $Id: localwebcalcreate,v 1.2 2002-03-07 16:22:51 jonas Exp $
-#
-# Create local WebCAL
-#
-
-NAME=webcal
-PATH=$PATH:/usr/local/sbin
-USER=$2
-HOME=/web/$USER
-CGI=$HOME/www/cgi-local
-NEWNAME=kalender
-CAL=$HOME/www/$NEWNAME
-
-test "x$USER" = "x" && $1=""
-
-case "$1" in
- add)
- test "x$USER" = "x" && exit 1
- echo -n "Adding calendar to webserver $USER: "
- test -d $CGI || mkdir $CGI
- chown $USER.www-data $CGI
- cp /usr/local/lib/scripts/darryl/webcal/webcal.pl $CGI/$NEWNAME.cgi
- cp /usr/local/lib/scripts/darryl/webcal/webcal.add.pl $CGI/$NEWNAME.cgi
- cp /usr/local/lib/scripts/darryl/webcal/webcal.config.pl $CGI/$NEWNAME.cgi
- cp /usr/local/lib/scripts/darryl/webcal/webcal.delete.pl $CGI/$NEWNAME.cgi
- chown $USER.www-data $CGI/NEWNAME*.cgi
- chmod g+x,o= $CGI/$NEWNAME*.cgi
- mkdir $HOME/webcal
- cp /usr/local/lib/scripts/darryl/webcal/webcal.data $HOME/webcal/
- chown -R $USER.www-data $HOME/webcal
- chmod g+w $HOME/webcal/webcal.data
- mkdir $CAL
- chown -R $USER.www-data $CAL
- echo "Done!"
- ;;
- del|delete|remove)
- test -d $HOME/webcal || exit 1
- echo -n "Deleting calendar from webserver $USER: "
- rm -rf $CGI/$NEWNAME*.cgi
- rm -rf $HOME/webcal
- rm -rf $CAL
- echo "Done!"
- ;;
- *)
- echo "Usage: $NAME [ add | delete ] WEBSERVER"
- exit 1
- ;;
-esac
-
-exit 0
diff --git a/wcald b/wcald
deleted file mode 100755
index 0d7b8d2..0000000
--- a/wcald
+++ /dev/null
@@ -1,3688 +0,0 @@
-#!/usr/bin/perl -w
-#
-# Wcal 2.0 copyright by Joël Savignon <js@neosystem.com>.
-#
-# Released under GNU General Public License (GPL).
-#
-# TAB size 4
-#
-
-require 5.004;
-use Data::Dumper;
-use Date::Manip;
-use Socket;
-use strict;
-no strict 'refs';
-
-# These you can edit
-$::CONF_FILE = '/etc/wcal.conf';
-$::MSG_FILE = '/etc/wcal.msg';
-$::DIRECTORY = '/var/www/VIRTUAL/www.homebase.dk/www/wcal';
-$::DB_DIR = '/var/wcal'; # settable in wcal.conf in 1.x versions
-$::REFRESH_DELAY = 900; # view refreshed every 900 seconds = 15 minutes
-$::PATH_BASENAME = 'wcal'; # last component of the wcal directory name
-
-# Values below affect the proportions of the frames
-$::FIRST_HOUR = 8;
-$::LAST_HOUR = 23;
-$::MANY_WEEKS_VERT = 2;
-$::MANY_WEEKS_HOR = 7;
-$::FIRST_DAY = 'monday';
-
-# Colors
-$::THCOLOR = '#E2E3FC';
-$::TDCOLOR = '#D9F4F4';
-$::NOW_THCOLOR = '#CAFFD0';
-$::NOW_TDCOLOR = '#CAFFD0';
-$::REPEAT_WEEK_TEXTCOLOR = '#C02090';
-$::REPEAT_MONTH_TEXTCOLOR = '#008844';
-$::BG_TDCOLOR = '#F2F3FC';
-$::ERROR_COLOR = '#e06060';
-@::EVENT_COLS = ('#D9F4F4','#FFFFAA','#AAFFFF','#FFAAFF','#FFAAAA','#AAAAFF','#AAFFAA','#80FFE0','#E080E0','#C0DCC0','#C0C0C0','#FF0080','#A4C8F0','#FF8000','#FF80C0','#8080C0','#FFFFFF');
-
-# No need to touch these
-$::MAX_DURATION = 21; # maximum duration of an event in days
-$::CURRENT_DB_VERSION = 2; # Wcal 1.00 had version 1 databases
-$::HTTP_HEADER = "Content-Type: text/html\n\n";
-
-# internationalization
-sub __
-{
- my $str = shift;
- return $::msgs->{$str}->{$::REMOTE_LANG} || $str;
-}
-
-# fusion
-sub strcal
-{
- if ($::query->{'cal'})
- {
- return "&cal=".join("&cal=",split(/\n/,$::query->{'cal'}));
- }
- else
- {
- return "";
- }
-}
-
-sub lncal
-{
- my $year = shift;
- my $week = shift;
-
- if ($::query->{'cal'})
- {
- my $str = $::BASE_URL.'/fusion.cgi?t=links&cal='.join("&cal=",split(/\n/,$::query->{'cal'}));
- if ($year && $week)
- {
- $str .= '&year='.$year.'&week='.$week;
- }
- return "<a onClick='window.open(\"$str\", \"links\", \"toolbar=no,menubar=no,scrollbars=yes,width=250,height=200,resizable=yes\"); return false' href=\"$str\" target=\"_top\">$::LONG_NAME</a>";
- }
- else
- {
- return $::LONG_NAME;
- }
-}
-
-# Query string decoder, ripped from CGI_Lite
-sub decode_url_encoded_data ($) {
- my ($reference_data) = @_;
- my ($code, $self);
-
- $code = <<'End_of_URL_Decode';
-
- my (@key_value_pairs, $delimiter, $key_value, $key, $value);
-
- @key_value_pairs = ();
-
- return unless ($$reference_data);
-
- $delimiter = '&';
-
- $$reference_data =~ tr/+/ /;
- @key_value_pairs = split (/$delimiter/, $$reference_data);
-
- foreach $key_value (@key_value_pairs) {
- ($key, $value) = split (/=/, $key_value, 2);
-
- $key =~ s/%([\da-fA-F]{2})/chr (hex ($1))/eg;
- $value =~ s/%([\da-fA-F]{2})/chr (hex ($1))/eg;
-
-# print Socket "'$key':'$value'\n";
-
- if ($self->{$key})
- {
- $self->{$key} .= "\n$value";
- }
- else
- {
- $self->{$key} = $value;
- }
- }
-
-End_of_URL_Decode
-
- eval ($code);
- return $self;
-}
-
-# And encoder, ripped too
-sub url_encode
-{
- my $string = shift;
- my $str1 = '([\x00-\x20"#%;<>?{}|\\\\^~`\[\]\x7F-\xFF])';
- $string =~ s/$str1/
- sprintf ('%%%x', ord ($1))/eg;
-
- return $string;
-}
-
-sub strip_space ($) {
- my ($s) = @_;
- $s =~ s/^\s*(.*?)\s*$/$1/;
- return $s;
-}
-
-sub wday_to_dmwday ($) {
- my ($wday) = @_;
-
- if ($::FIRST_DAY eq 'monday') {
- return ($wday + 1);
- } else {
- if ($wday == 0) {
- return 7;
- } else {
- return $wday;
- }
- }
-}
-
-sub dmwday_to_wday ($) {
- my ($dmwday) = @_;
-
- return ($::FIRST_DAY eq 'monday' ?
- $dmwday - 1 :
- $dmwday % 7);
-}
-
-sub get_now () {
- if (! defined $::now_cache) {
- my (@n);
- @n = &UnixDate (&ParseDate ('now'), $::FIRST_DAY eq 'monday' ? "%G": "%L", "%m", "%d", $::FIRST_DAY eq 'monday' ? "%W" : "%U", "%w");
- $::now_cache = {
- 'year' => $n[0] + 0,
- 'month' => $n[1] + 0,
- 'day' => $n[2] + 0,
- 'week' => $n[3] + 0,
- 'wday' => dmwday_to_wday ($n[4]) };
- }
- return $::now_cache;
-}
-
-sub get_next_year_week ($$) {
- my ($year, $week) = @_;
- my ($cacheid);
-
- $cacheid = sprintf ("%04d%02d", $year, $week);
- if (! defined $::nyw_cache{$cacheid}) {
- my ($y, $w);
- ($y, $w) = &UnixDate (&DateCalc ("$::FIRST_DAY week $week in $year", "+ 7 days"), $::FIRST_DAY eq 'monday' ? "%G": "%L", $::FIRST_DAY eq 'monday' ? "%W" : "%U");
- $::nyw_cache{$cacheid} = [$y + 0, $w + 0];
- }
- return @{$::nyw_cache{$cacheid}};
-}
-
-sub get_prev_year_week ($$) {
- my ($year, $week) = @_;
- my ($cacheid);
-
- $cacheid = sprintf ("%04d%02d", $year, $week);
- if (! defined $::pyw_cache{$cacheid}) {
- my ($y, $w);
- ($y, $w) = &UnixDate (&DateCalc ("$::FIRST_DAY week $week in $year", "- 7 days"), $::FIRST_DAY eq 'monday' ? "%G": "%L", $::FIRST_DAY eq 'monday' ? "%W" : "%U");
- $::pyw_cache{$cacheid} = [$y + 0, $w + 0];
- }
- return @{$::pyw_cache{$cacheid}};
-}
-
-sub get_month_day_by_firstday_year_week ($$) {
- my ($year, $week) = @_;
- my ($cacheid);
-
- $cacheid = sprintf ("%04d%02d", $year, $week);
- if (! defined $::md_cache{$cacheid}) {
- my ($month, $day);
- ($month, $day) = &UnixDate (&ParseDate ("$::FIRST_DAY week $week in $year"), "%m", "%d");
- $::md_cache{$cacheid} = [$month + 0, $day + 0];
- }
- return @{$::md_cache{$cacheid}};
-}
-
-sub get_month_day_by_wday_year_week ($$$) {
- my ($wday, $year, $week) = @_;
- my ($cacheid);
-
- $cacheid = sprintf ("%04d%02d%1d", $year, $week, $wday);
- if (! defined $::md2_cache{$cacheid}) {
- my ($month, $day);
- ($month, $day) = &UnixDate (&ParseDate ($::weekdays2[$wday] . " week $week in $year"), "%m", "%d");
- $::md2_cache{$cacheid} = [$month + 0, $day + 0];
- }
- return @{$::md2_cache{$cacheid}};
-}
-
-sub get_year_week_by_firstday_year_week_minus_days ($$$) {
- my ($year, $week, $days) = @_;
- my ($cacheid);
-
- $cacheid = sprintf ("%04d%02d%10d", $year, $week, $days);
- if (! defined $::yw_cache{$cacheid}) {
- my ($ryear, $rweek);
- ($ryear, $rweek) = &UnixDate (&DateCalc ("$::FIRST_DAY week $week in $year", "- $days days"), $::FIRST_DAY eq 'monday' ? "%G": "%L", $::FIRST_DAY eq 'monday' ? "%W" : "%U");
- $::yw_cache{$cacheid} = [$ryear + 0, $rweek + 0];
- }
- return @{$::yw_cache{$cacheid}};
-}
-
-sub week_wday_by_year_month_day ($$$) {
- my ($year, $month, $day) = @_;
- my ($cacheid);
-
- $cacheid = sprintf ("%04d%02d%2d", $year, $month, $day);
- if (! defined $::ww_cache{$cacheid}) {
- my ($week, $wday);
- ($week, $wday) = &UnixDate (&ParseDate ("$month/$day/$year"), $::FIRST_DAY eq 'monday' ? "%W" : "%U", "%w");
- $::ww_cache{$cacheid} = [$week + 0, dmwday_to_wday ($wday)];
- }
- return @{$::ww_cache{$cacheid}};
-}
-
-sub get_start_end_by_year_week_wday_duration ($$$$) {
- my ($startyear, $startweek, $startwday, $duration) = @_;
- my ($cacheid);
-
- $cacheid = sprintf ("%04d%02d%2d%03d", $startyear, $startweek, $startwday, $duration);
- if (! defined $::se_cache{$cacheid}) {
- my ($startmonth, $startday, $endyear, $endweek, $endwday, $endmonth, $endday);
-
- ($startmonth, $startday) = get_month_day_by_wday_year_week ($startwday, $startyear, $startweek);
-
- ($endyear, $endweek, $endwday) =
- &UnixDate (&DateCalc (&ParseDate (sprintf ("%04d-W%02d-%1d", $startyear, $startweek, wday_to_dmwday ($startwday))),
- "+ " . ($duration - 1) . " days"),
- $::FIRST_DAY eq 'monday' ? "%G": "%L", $::FIRST_DAY eq 'monday' ? "%W" : "%U", "%w");
- $endwday = dmwday_to_wday ($endwday);
-
- ($endmonth, $endday) = get_month_day_by_wday_year_week ($endwday, $endyear, $endweek);
-
- $::se_cache{$cacheid} =
- [
- $startmonth + 0, $startday + 0,
- $endyear + 0, $endweek + 0, dmwday_to_wday ($endwday),
- $endmonth + 0, $endday + 0
- ];
- }
- return @{$::se_cache{$cacheid}};
-}
-
-sub get_year_week_wday_by_year_week_wday_plus_days ($$$$) {
- my ($year, $week, $wday, $days) = @_;
- my ($cacheid);
-
- $cacheid = sprintf ("%04d%02d%02d%10d", $year, $week, $wday, $days);
- if (! defined $::yww_cache{$cacheid}) {
- my ($nyear, $nweek, $nwday);
- ($nyear, $nweek, $nwday) =
- &UnixDate (&DateCalc (sprintf ("%04d-W%02d-%1d", $year, $week, wday_to_dmwday ($wday)),
- "+ $days days"),
- $::FIRST_DAY eq 'monday' ? "%G": "%L",
- $::FIRST_DAY eq 'monday' ? "%W" : "%U",
- "%w");
- $::yww_cache{$cacheid} = [$nyear + 0, $nweek + 0, dmwday_to_wday ($nwday)];
- }
- return @{$::yww_cache{$cacheid}};
-}
-
-sub fit_in_week ($$$$) {
- my ($year, $week, $wday, $duration) = @_;
- my ($endyear, $endweek, $endwday);
-
- ($endyear, $endweek, $endwday) =
- get_year_week_wday_by_year_week_wday_plus_days
- ($year, $week, $wday, $duration-1);
- if ($endyear != $year or $endweek != $week) {
- return 0;
- } else {
- return 1;
- }
-}
-
-sub fit_in_month ($$$$) {
- my ($year, $week, $wday, $duration) = @_;
- my ($month, $day);
- my ($endyear, $endweek, $endwday);
- my ($endmonth, $endday);
-
- ($month, $day) = get_month_day_by_wday_year_week ($wday, $year, $week);
- ($endyear, $endweek, $endwday) =
- get_year_week_wday_by_year_week_wday_plus_days
- ($year, $week, $wday, $duration-1);
- ($endmonth, $endday) = get_month_day_by_wday_year_week ($endwday, $endyear, $endweek);
- if ($endyear != $year or $endmonth != $month) {
- return 0;
- } else {
- return 1;
- }
-}
-
-sub clipboard_set ($$) {
- my ($key, $data_ref) = @_;
- $::clipboard{$key} = $data_ref;
- return;
-}
-
-sub clipboard_get ($) {
- my ($key) = @_;
- if (defined $::clipboard{$key}) {
- return $::clipboard{$key};
- } else {
- return '';
- }
-}
-
-sub format_hour ($) {
- my ($hour) = @_;
-
- if ($::CLOCK eq '24-hour') {
- return ($hour + 0);
- } else {
- my ($newhour);
-
- $newhour = $hour;
- $newhour = 24 if $hour == 0;
- $newhour -= 12 if $hour > 12;
- return ($newhour + 0) . ($hour < 12 ? "am" : "pm");
- }
-}
-
-sub format_hour_padded ($) {
- my ($hour) = @_;
-
- if ($::CLOCK eq '24-hour') {
- return sprintf ("%02d", $hour);
- } else {
- my ($newhour);
-
- $newhour = $hour;
- $newhour = 24 if $hour == 0;
- $newhour -= 12 if $hour > 12;
- return sprintf ("%02d", $newhour) . ($hour < 12 ? "am" : "pm");
- }
-}
-
-sub format_time ($$) {
- my ($hour, $min) = @_;
-
- if ($::CLOCK eq '24-hour') {
- return ($hour + 0) . ":" . sprintf ("%02d", $min);
- } else {
- my ($newhour);
-
- $newhour = $hour;
- $newhour = 24 if $hour == 0;
- $newhour -= 12 if $hour > 12;
- return ($newhour + 0) . ":" . sprintf ("%02d", $min) . ($hour < 12 ? "am" : "pm");
- }
-}
-
-sub format_time_padded ($$) {
- my ($hour, $min) = @_;
-
- if ($::CLOCK eq '24-hour') {
- return sprintf ("%02d", $hour) . ":" . sprintf ("%02d", $min);
- } else {
- my ($newhour);
-
- $newhour = $hour;
- $newhour = 24 if $hour == 0;
- $newhour -= 12 if $hour > 12;
- return sprintf ("%02d", $newhour) . ":" . sprintf ("%02d", $min) . ($hour < 12 ? "am" : "pm");
- }
-}
-
-sub format_alarm_type {
- my ($type, $single) = @_;
-
- if ($type == 1)
- {
- if ($single)
- {
- return __("minute");
- }
- else
- {
- return __("minutes");
- }
- }
- elsif ($type == 2)
- {
- if ($single)
- {
- return __("heure");
- }
- else
- {
- return __("heures");
- }
- }
- elsif ($type == 3)
- {
- if ($single)
- {
- return __("jour");
- }
- else
- {
- return __("jours");
- }
- }
- else
- {
- return "";
- }
-}
-
-sub img_alarm {
- my ($val, $type, $chk) = @_;
- if ($val)
- {
- my $img = ($chk ? "alarm2" : "alarm");
- return ' <IMG SRC="'. $::IMG_URL . '/' . $img . '.gif" ALT="'.__("Alarme")." : ".$val." ".format_alarm_type($type, ($val == 1)).'">';
- }
- else
- {
- return "";
- }
-}
-sub img_note {
- my ($data) = @_;
- if ($data)
- {
- $data =~ s/<BR>/ /mg;
- return ' <IMG SRC="' . $::IMG_URL . '/note.gif" ALT="'.__("Note")." : ".$data.'">';
- }
- else
- {
- return "";
- }
-}
-
-sub txt_alarm {
- my ($val, $type, $chk) = @_;
- if ($val)
- {
- my $col = ($chk ? "#00AA00" : "#FF0000");
- return '<BR><FONT COLOR="'.$col.'">'.__("Alarme")." : ".$val." ".format_alarm_type($type, ($val == 1)).'</FONT>';
- }
- else
- {
- return "";
- }
-}
-
-sub has_html ($) {
- my ($text) = @_;
- return $text =~ /[<>&]/;
-}
-
-
-sub newline_to_html ($) {
- my ($text) = @_;
- $text =~ s/\015\012/<BR>/sg;
- return $text;
-}
-
-sub html_to_newline ($) {
- my ($text) = @_;
- $text =~ s/<BR>/\015\012/sg;
- return $text;
-}
-
-sub events_version ($) {
- my ($events) = @_;
- my ($version);
- $version = $events->[0];
- if (ref $version) {
- $version = 1;
- }
- return $version;
-}
-
-sub convert_events_from_v1_to_v2 ($$$) {
- my ($events, $year, $week) = @_;
- my ($dayid, $eventhour, $eventid);
- for $dayid (0 .. $#$events) {
- for $eventhour (keys %{$events->[$dayid]}) {
- for $eventid (0 .. $#{$events->[$dayid]->{$eventhour}}) {
- my (@old_event, %new_event);
- @old_event = @{$events->[$dayid]->{$eventhour}->[$eventid]};
- %new_event = (
- 'id' => $old_event[0],
- 'min' => $old_event[1],
- 'lengthmin' => $old_event[2],
- 'title' => $old_event[3],
- 'data' => $old_event[4],
- 'rt' => $old_event[5],
- 'startyear' => $year,
- 'startweek' => $week,
- 'startwday' => $dayid,
- 'duration' => 1
- );
- $events->[$dayid]->{$eventhour}->[$eventid] = \%new_event;
- }
- }
- }
- # insert version number into beginning of the array
- unshift (@$events, $::CURRENT_DB_VERSION);
- return;
-}
-
-sub read_events ($;$$) {
- my ($rt, $year, $week) = @_;
- my ($filename, $now);
-
- my @filenames;
- my $id;
- my ($refs, $ref, $old_slash);
-
- if ($main::DATA_ID)
- {
- if ($rt eq 'n') {
- $filename = sprintf "$::DB_DIR/w-$main::DATA_ID-%04d%02d.db", $year, $week;
- } else {
- $filename = "$::DB_DIR/r$rt-$main::DATA_ID.db";
- }
- if (open F, $filename) {
- $old_slash = $/;
- undef $/;
- $refs = eval (<F>);
- $/ = $old_slash;
- close F;
- # backwards compatibility
- if (events_version ($refs) < 2) {
- $now = get_now ();
- convert_events_from_v1_to_v2 ($refs, $year || $now->{'year'}, $week || $now->{'week'});
- }
- shift @$refs;
- }
- }
- elsif ($main::DATA_IDS)
- {
- my $cl = 0;
- foreach $id (split(/\n/,$main::DATA_IDS))
- {
- $cl++;
- if ($rt eq 'n') {
- $filename = sprintf "$::DB_DIR/w-$id-%04d%02d.db", $year, $week;
- } else {
- $filename = "$::DB_DIR/r$rt-$id.db";
- }
- if (open F, $filename) {
- $old_slash = $/;
- undef $/;
- $ref = eval (<F>);
- $/ = $old_slash;
- close F;
- # backwards compatibility
- if (events_version ($ref) < 2) {
- $now = get_now ();
- convert_events_from_v1_to_v2 ($ref, $year || $now->{'year'}, $week || $now->{'week'});
- }
- shift @$ref;
-
- # add cal index
- my $i;
- my $key;
- my $val;
- my $vl;
- for ($i=0; $i < ($rt eq 'm' ? 32 : 7); $i++)
- {
- while (($key, $val) = each (%{@{$ref}[$i]}))
- {
- foreach $vl (@{$val})
- {
- %{$vl}->{cal} = $cl;
- }
- }
- }
-
- if (!$refs)
- {
- $refs = $ref;
- next;
- }
- # fusion
- for ($i=0; $i < ($rt eq 'm' ? 32 : 7); $i++)
- {
- while (($key, $val) = each (%{@{$ref}[$i]}))
- {
- if (%{@{$refs}[$i]}->{$key})
- {
- push @{%{@{$refs}[$i]}->{$key}}, @{$val};
- }
- else
- {
- @{%{@{$refs}[$i]}->{$key}} = @{$val};
- }
- }
- }
- }
- }
- }
- if ($refs)
- {
- return $refs;
- } elsif ($rt eq 'n' or $rt eq 'w') {
- return [ {}, {}, {}, {}, {}, {}, {} ];
- } elsif ($rt eq 'm') {
- # let's give month 32 days to make sure
- return [ {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {} ]
- }
- # can't happen
-}
-
-
-sub write_events ($$;$$) {
- my ($weekdata, $rt, $year, $week) = @_;
- my ($filename);
-
- if ($rt eq 'n') {
- if (! defined $year or ! $year or ! defined $week or ! $week) {
- return "The file type is no-repeat, but week or year not given, or zero.";
- }
- $filename = sprintf "$::DB_DIR/w-${main::DATA_ID}-%04d%02d.db", $year, $week;
- # Remove cached week file
- unlink sprintf ("$::DB_DIR/cache/w-${main::DATA_ID}-%04d%02d.html", $year, $week);
- } else {
- my (@files);
- $filename = "$::DB_DIR/r$rt-${main::DATA_ID}.db";
- # Remove all cached week files
- if (opendir (TDH, "$::DB_DIR/cache")) {
- @files = grep { /^w-${main::DATA_ID}-\d{6}\.html$/ } readdir (TDH);
- closedir TDH;
- for (@files) {
- unlink "$::DB_DIR/cache/$_";
- }
- }
-}
-
-# add the version identifier
-unshift (@$weekdata, $::CURRENT_DB_VERSION);
-
-if (open F, ">$filename") {
- $Data::Dumper::Terse = 1;
- flock (F, 2);
- print F Dumper ($weekdata);
- flock (F, 8);
- close F;
- return '';
-} else {
- return "File $filename can't be opened for writing: $!";
-}
-
-# and remove the version identifier again
-shift @$weekdata;
-}
-
-sub read_general () {
- my ($week) = @_;
- if (-f "$::DB_DIR/general.db" and ! -r "$::DB_DIR/general.db") {
- return "No write permission for file $::DB_DIR/general.db";
- }
- if (open F, "$::DB_DIR/general.db") {
- my ($ref, $old_slash);
- $old_slash = $/;
- undef $/;
- $ref = eval (<F>);
- $/ = $old_slash;
- close F;
- if ($@) {
- return "Error in processing file $::DB_DIR/general.db: $@";
- } else {
- return $ref;
- }
- } else {
- return { 'highid' => 56 };
- }
-}
-
-sub write_general ($) {
- my ($gendata) = @_;
- if (open F, ">$::DB_DIR/general.db") {
- $Data::Dumper::Terse = 1;
- flock (F, 2);
- print F Dumper ($gendata);
- flock (F, 8);
- close F;
- return '';
- } else {
- return "File $::DB_DIR/general.db can't be opened for writing: $!";
- }
-}
-
-# Print year, month and day in chosen date format
-sub pd_year_month_day ($$$) {
- my ($year, $month, $day) = @_;
- my ($t);
-
- $t = $::DATE_FORMAT;
- if ($t == 1) {
- return "$day.$month.$year";
- } elsif ($t == 2) {
- return "$month/$day/$year";
- } elsif ($t == 3) {
- return "$day/$month/$year";
- } elsif ($t == 4) {
- return "$year/$month/$day";
- } elsif ($t == 5) {
- return "$year-$month-$day";
- } elsif ($t == 5) {
- return sprintf ("%04d%02d%02d", $year, $month, $day);
- } else {
- return "[DATE TYPE $t]";
- }
-}
-
-sub pd_month_day ($$) {
- my ($month, $day) = @_;
- my ($t);
-
- $t = $::DATE_FORMAT;
- if ($t == 1) {
- return "$day.$month";
- } elsif ($t == 2) {
- return "$month/$day";
- } elsif ($t == 3) {
- return "$day/$month";
- } elsif ($t == 4) {
- return "$month/$day";
- } elsif ($t == 5) {
- return "$month-$day";
- } elsif ($t == 6) {
- return sprintf ("%02d%02d", $month, $day);
- } else {
- return "[DATE TYPE $t]";
- }
-}
-
-sub pd_month_day_padded ($$) {
- my ($month, $day) = @_;
- my ($t);
-
- $t = $::DATE_FORMAT;
- if ($t == 1) {
- return sprintf "%02d.%02d", $day, $month;
- } elsif ($t == 2) {
- return sprintf "%02d/%02d", $month, $day;
- } elsif ($t == 3) {
- return sprintf "%02d/%02d", $day, $month;
- } elsif ($t == 4) {
- return sprintf "%02d/%02d", $month, $day;
- } elsif ($t == 5) {
- return sprintf "%02d-%02d", $month, $day;
- } elsif ($t == 6) {
- return sprintf "%02d%02d", $month, $day;
- } else {
- return "[DATE TYPE $t]";
- }
-}
-
-sub pd_single_event_date ($$$$) {
- my ($rt, $year, $week, $wday) = @_;
- my ($month, $day);
-
- ($month, $day) = get_month_day_by_wday_year_week ($wday, $year, $week);
- if ($rt eq 'n') {
- return pd_year_month_day ($year, $month, $day);
- } elsif ($rt eq 'w') {
- return __($::weekdays[$wday]);
- } else {
- return $day . ".";
- }
-}
-
-sub pd_event_date ($$$$$) {
- my ($rt, $startyear, $startweek, $startwday, $duration) = @_;
- my ($ret);
-
- $ret = '';
- $ret .= pd_single_event_date ($rt, $startyear, $startweek, $startwday);
- if ($duration > 1) {
- ($startyear, $startweek, $startwday) =
- get_year_week_wday_by_year_week_wday_plus_days
- ($startyear, $startweek, $startwday, $duration - 1);
- $ret .= " to " . pd_single_event_date ($rt, $startyear, $startweek, $startwday);
- }
- if ($rt eq 'w') {
- $ret .= " ".__("hebdomadaire");
- } elsif ($rt eq 'm') {
- $ret .= " ".__("mensuelle");
- }
- return $ret;
-}
-
-sub join_days (@) {
- my (@daylist) = @_;
- my (%sum_day, $day_ref, $hour, $event_ref);
-
- %sum_day = ();
- for $day_ref (@daylist) {
- for $hour (keys %$day_ref) {
- for $event_ref (@{$day_ref->{$hour}}) {
- push @{$sum_day{$hour}}, $event_ref;
- }
- }
- }
- return \%sum_day;
-}
-
-sub build_day ($$$$) {
- my ($year, $week, $wday, $day) = @_;
- my ($e_n, $e_rw, $e_rm, $sum_day_ref);
-
- $e_n = read_events ('n', $year, $week);
- $e_rw = read_events ('w');
- $e_rm = read_events ('m');
-
- $sum_day_ref = join_days ($e_n->[$wday], $e_rw->[$wday], $e_rm->[$day]);
- return $sum_day_ref;
-}
-
-sub build_week ($$) {
- my ($year, $week) = @_;
- my ($e_n, $e_rw, $e_rm, @sum_week, $wday);
-
- $e_n = read_events ('n', $year, $week);
- $e_rw = read_events ('w');
- $e_rm = read_events ('m');
-
- for $wday (0 .. 6) {
- my ($month, $day);
- ($month, $day) = get_month_day_by_wday_year_week ($wday, $year, $week);
- $sum_week[$wday] = join_days ($e_n->[$wday], $e_rw->[$wday], $e_rm->[$day]);
- }
- return \@sum_week;
-}
-
-sub build_week_list ($$) {
- my ($start_year, $start_week) = @_;
- my ($week_filename, @weeks, @ret, %weeks);
- my ($e_n, $e_rw, $e_rm, @sum_week);
- my ($cyear, $cweek, $cdate);
- my ($end_year, $end_week, $end_date);
-
- $e_rw = read_events ('w');
- $e_rm = read_events ('m');
-
- if ($main::DATA_ID)
- {
- if (! opendir (DIR, $::DB_DIR)) {
- return "can't open $::DB_DIR for reading: $!";
- }
-
- # gather all week filenames, 199805, 199806, 199807 ... 199851
- @weeks = map { /^w-$main::DATA_ID-(\d{4}\d{2})\.db$/ && $1 }
- grep { /^w-$main::DATA_ID-(\d{4}\d{2})\.db$/ &&
- $1 >= sprintf ("%04d%02d", $start_year, $start_week) }
- sort readdir(DIR);
- close DIR;
- }
- else
- {
- my $id;
- my @wks;
- foreach $id (split(/\n/,$main::DATA_IDS))
- {
- if (! opendir (DIR, $::DB_DIR)) {
- return "can't open $::DB_DIR for reading: $!";
- }
-
- # gather all week filenames, 199805, 199806, 199807 ... 199851
- @wks = map { /^w-$id-(\d{4}\d{2})\.db$/ && $1 }
- grep { /^w-$id-(\d{4}\d{2})\.db$/ &&
- $1 >= sprintf ("%04d%02d", $start_year, $start_week) }
- sort readdir(DIR);
- close DIR;
- push @weeks, @wks;
- }
- }
-
- # return immediately if no events
- if (scalar @weeks == 0) {
- return [];
- }
-
- # figure out the filename of the last week file
- $weeks[$#weeks] =~ /^(....)(..)$/;
- ($end_year, $end_week) = ($1, $2);
- $end_date = sprintf ("%04d%02d", $end_year, $end_week);
-
- # generate an array of filenames between first and last week filename into %weeks
- $cyear = $start_year; $cweek = $start_week;
- $cdate = sprintf "%04d%02d", $cyear, $cweek;
- do {
- $weeks{$cdate} = $weeks[0] == $cdate ? shift @weeks : 0;
- ($cyear, $cweek) = get_next_year_week ($cyear, $cweek);
- $cdate = sprintf "%04d%02d", $cyear, $cweek;
- } while ($cdate le $end_date);
-
- @ret = ();
- for $week_filename (sort keys %weeks) {
- my ($year, $week, @sum_week);
-
- $week_filename =~ /^(\d\d\d\d)(\d\d)/;
- ($year, $week) = ($1, $2);
-
- # if $weeks{$week_filename} has true value, then there are week
- # events for that week - only in that case we will use the repeat events
-
- if ($weeks{$week_filename}) {
- my ($e_n, $wday);
-
- $e_n = read_events ('n', $year, $week);
- # Combine week files and repeat files
- @sum_week = ();
- for $wday (0 .. 6) {
- my ($day, $month);
- ($month, $day) = get_month_day_by_wday_year_week ($wday, $year, $week);
- $sum_week[$wday] = join_days ($e_n->[$wday], $e_rw->[$wday], $e_rm->[$day]);
- }
- } else {
- @sum_week = ( {}, {}, {}, {}, {}, {}, {} ); # ignore repeat events too
- }
-
- push @ret, [\@sum_week, $year, $week];
- }
- return \@ret;
-}
-
-sub week_cache_read ($$) {
- my ($year, $week) = @_;
- my ($filename, $data, $old_slash);
- local (*CRFH);
-
- if (!$main::DATA_ID)
- {
- return undef;
- }
- $filename = sprintf "$::DB_DIR/cache/w-%s-%04d%02d.html", $main::DATA_ID, $year, $week;
- if (! open (CRFH, $filename)) {
- return undef;
- }
- $old_slash = $/;
- undef $/;
- $data = <CRFH>;
- $/ = $old_slash;
- close CRFH;
- return \$data;
-}
-
-sub week_cache_write_open ($$) {
- my ($year, $week) = @_;
- my ($dirname, $filename, $cfh);
- $cfh = 'this_is_a_filehandle';
-
- $dirname = "$::DB_DIR/cache";
- if ($main::DATA_ID)
- {
- $filename = sprintf "%s/w-%s-%04d%02d.html", $dirname, $main::DATA_ID, $year, $week;
- }
- else
- {
- $filename = sprintf "%s/w-fusion-%04d%02d.html", $dirname, $year, $week;
- }
-if (! -e $dirname) {
- if (! mkdir ($dirname, 0770)) {
- my $str1 = "can't create directory $dirname: $!";
- return \$str1;
- }
-}
-if (! open ($cfh, ">$filename")) {
- my $str2 = "can't open file $filename for writing: $!";
- return \$str2;
-}
-flock ($cfh, 2);
-return $cfh;
-}
-
-sub header_body ($) {
- return \$::H_BODY;
-}
-
-sub week_cache_write_close ($) {
- my ($fh) = @_;
- if (fileno(F))
- {
- flock (F, 8);
- }
- close $fh;
-}
-
-sub week_split_events_noon ($) {
- my ($events_ref) = @_;
- my ($e1, $e2, $e3, $day, $hour);
-
- for (@$events_ref) {
- for $day (0 .. 6) {
- my (%hours);
- %hours = %{$events_ref->[$day]};
- $e1->[$day] = {}; $e2->[$day] = {}; $e3->[$day] = {};
- if (%hours) {
- for $hour (keys %hours) {
- if ($hour == -1)
- {
- $e3->[$day]->{$hour} = $events_ref->[$day]->{$hour};
- }
- elsif ($hour < 12)
- {
- $e1->[$day]->{$hour} = $events_ref->[$day]->{$hour};
- } else
- {
- $e2->[$day]->{$hour} = $events_ref->[$day]->{$hour};
- }
- }
- }
- }
- }
- return ($e1, $e2, $e3);
-}
-
-sub week_print_events ($$$$$$) {
- my ($fh, $events_ref, $use_now_wday, $year, $week, $weekdays_ref) = @_;
- my ($day_offset, $day_ref, $hour, $event_ref);
-
- $day_offset = 0;
- for $day_ref (@$events_ref) {
- if (%$day_ref) {
- print $fh "<TD BGCOLOR=\"$::TDCOLOR\" VALIGN=top>\n";
- print $fh "<table width=100% cellpadding=0 cellspacing=0 border=0>\n";
- for $hour (sort { $a <=> $b } keys %$day_ref) {
- for $event_ref (@{$day_ref->{$hour}}) {
- print $fh '<tr><td bgcolor="'.$::EVENT_COLS[$event_ref->{'cal'} || 0].'">';
- my ($id, $min, $title, $data, $lengthmin, $rt, $color, $color_end);
- my ($startyear, $startweek, $startwday, $duration);
- my ($alval, $altype, $alchk, $strike);
-
- $id = $event_ref->{'id'};
- $min = $event_ref->{'min'};
- $lengthmin = $event_ref->{'lengthmin'};
- $title = $event_ref->{'title'};
- $data = $event_ref->{'data'};
- $rt = $event_ref->{'rt'};
- $startyear = $event_ref->{'startyear'};
- $startweek = $event_ref->{'startweek'};
- $startwday = $event_ref->{'startwday'};
- $duration = $event_ref->{'duration'};
- $alval = $event_ref->{'alval'} || 0;
- $altype = $event_ref->{'altype'} || 0;
- $alchk = $event_ref->{'alchk'} || "";
- $strike = $event_ref->{'strike'} || 0;
-
- if ($rt eq 'w') {
- $color = "<FONT COLOR=\"$::REPEAT_WEEK_TEXTCOLOR\" SIZE=2>";
- } elsif ($rt eq 'm') {
- $color = "<FONT COLOR=\"$::REPEAT_MONTH_TEXTCOLOR\" SIZE=2>";
- } else {
- $color = '<FONT SIZE=2>';
- }
- $color_end = "</FONT>";
- my $st = strcal();
- print $fh "<A TARGET=fevent HREF=\"$::MY_URL_XUSER/?t=event$st",
- "&id=", $id,
- "&year=", $year, "&week=", $week, "&wday=", $day_offset,
- "&hour=", $hour,
- "&min=", $min,
- "&lengthmin=", $lengthmin,
- "&title=", url_encode ($title),
- "&data=", url_encode ($data),
- "&rt=", $rt,
- "&startyear=", $startyear,
- "&startweek=", $startweek,
- "&startwday=", $startwday,
- "&duration=", $duration,
- "&alval=", $alval,
- "&altype=", $altype,
- "&alchk=", $alchk,
- "&strike=", $strike,
- "\">$color",
- $strike ? "<strike><i>" : "",
- $hour == -1 ? "" : ("<b>",format_time ($hour, $min)," - ",format_time (int ($hour + ($min + $lengthmin)/60) % 24, ($min + $lengthmin) % 60),"</b> "),
- $title,
- $strike ? "</i></strike>" : "",
- $color_end, "</A>",
- img_note($data),
- img_alarm($alval, $altype, $alchk),
- "</td></tr>\n";
- }
- }
- print $fh "</table>\n";
- } else {
- print $fh "<TD BGCOLOR=\"$::BG_TDCOLOR\"><FONT SIZE=2>&nbsp;</FONT>\n";
- }
- $day_offset++;
- }
- return;
-}
-
-# CGI input: year, week OR nothing, in which case current date is used
-sub show_week (;$) {
- my ($cacheonly) = @_;
- my ($week, $month, $day, $year, $first_day);
- my ($weekdata, $i, @weekdays, $cached_week_ref, $cache_fh);
- my ($now_date, $now_year, $now_week, $now_wday, $use_now_wday);
- my ($events1, $events2, $events3, $wday_name, $now_ref);
-
- $year = $::query->{'year'};
- $week = $::query->{'week'};
- if (! defined $year or ! defined $week) {
- my ($ref);
- $ref = get_now ();
- ($year, $week) = ($ref->{'year'}, $ref->{'week'});
- }
-
- # If the week is in cache, return it
- sw_check_cache:
- $cached_week_ref = week_cache_read ($year, $week);
- if (defined $cached_week_ref) {
- $$cached_week_ref =~ s/X_USER_X/$main::USER/g;
- print Socket $$cached_week_ref;
- return;
- }
-
- # Find the current day to mark it in the output
- $now_ref = get_now ();
- ($now_year, $now_week, $now_wday) = ($now_ref->{'year'}, $now_ref->{'week'}, $now_ref->{'wday'});
-
- if ($year == $now_year and $week == $now_week) {
- $use_now_wday = $now_wday + 0;
- } else {
- $use_now_wday = -1;
- }
-
- if (defined $main::DATA_ID && $main::DATA_ID)
- {
- # Start writing the week into cache
- $cache_fh = week_cache_write_open ($year, $week);
- if (ref $cache_fh) {
- print Socket "<BODY>Internal error: $$cache_fh</BODY>\n";
- return;
- }
- }
- else # fusion
- {
- $cache_fh = "Socket";
- }
-
- # Build year/month/day information of the required week
- ($month, $day) = get_month_day_by_firstday_year_week ($year, $week);
- $weekdays[0] = [$month, $day];
- for $i (1..6) {
- my ($month, $day);
- ($month, $day) = get_month_day_by_wday_year_week ($i, $year, $week);
- $weekdays[$i] = [$month, $day];
- }
-
- my $st = strcal();
- print $cache_fh "<HEAD><META HTTP-EQUIV=refresh CONTENT=\"$::REFRESH_DELAY; url=$::MY_URL_XUSER/?t=week&year=$year&week=$week$st\"></HEAD>\n";
- print $cache_fh $::H_BODY;
-
- # Determine previous and next year & week
- my ($prev_week, $next_week, $prev_year, $next_year);
- $prev_week = $week - 1; $next_week = $week + 1;
- $prev_year = $next_year = $year;
- if ($prev_week < 2) {
- ($prev_year, $prev_week )= get_prev_year_week ($year, $week);
- } elsif ($next_week > 50) {
- ($next_year, $next_week )= get_next_year_week ($year, $week);
- }
-
- # cal links for fusion
- my $stl = lncal($year, $week);
-
- # Output title line
- print $cache_fh "<TABLE COLS=4 BORDER=0 WIDTH=\"100%\" ALIGN=center>\n";
- print $cache_fh "<TR><TH ALIGN=center><FONT SIZE=6><B>$stl</B></FONT></TH>\n";
- print $cache_fh "<TH COLSPAN=2 ALIGN=center><A TARGET=fweek HREF=\"$::MY_URL_XUSER/?t=week&year=$prev_year&week=$prev_week$st\"><IMG ALT=\"".__("Semaine précédente")."\" SRC=\"$::IMG_URL/left-arrow.gif\" ALIGN=middle BORDER=0></A>\n";
- print $cache_fh " <A TARGET=fweek HREF=\"$::MY_URL_XUSER/?t=week&year=$now_year&week=$now_week$st\"><FONT SIZE=4><B>",sprintf(__("%s Semaine %s Année %s"),__($::months[$month]),$week,$year),"</B></FONT></A> \n";
- print $cache_fh "<A TARGET=fweek HREF=\"$::MY_URL_XUSER/?t=week&year=$next_year&week=$next_week$st\"><IMG ALT=\"".__("Semaine suivante")."\" SRC=\"$::IMG_URL/right-arrow.gif\" ALIGN=middle BORDER=0></A></TH>\n";
- print $cache_fh "<TH ALIGN=center><A TARGET=fevent HREF=\"$::MY_URL_XUSER/?t=views&year=$year&week=$week$st\">".__("Autres vues")."</A></TH>\n";
- print $cache_fh "</TR></TABLE>\n\n";
-
- print $cache_fh "<TABLE COLS=7 BORDER=1 WIDTH=\"100%\">\n";
- print $cache_fh "<TR>\n";
-
- # Print weekday names
- $i = 0;
- for $wday_name (@main::weekdays_short) {
- my ($color);
- if ($i == $use_now_wday) {
- $color = $::NOW_THCOLOR;
- } else {
- $color = $::THCOLOR;
- }
- if ($i <= 4) {
- print $cache_fh "<TH BGCOLOR=\"$color\">";
- } else {
- print $cache_fh "<TH BGCOLOR=\"$color\">";
- }
- my $st = strcal();
- print $cache_fh "<A TARGET=fday HREF=\"$::MY_URL_XUSER/?t=day&year=", $year, "&week=", $week, "&wday=", $i, "$st\">", pd_month_day ($weekdays[$i]->[0], $weekdays[$i]->[1]), " ", __($wday_name), "</A>\n";
- $i++;
- }
-
- $weekdata = build_week ($year, $week);
- ($events1, $events2, $events3) = week_split_events_noon ($weekdata);
-
- print $cache_fh "<TR>\n";
- week_print_events ($cache_fh, $events1, $use_now_wday, $year, $week, \@weekdays);
- print $cache_fh "<TR>\n";
- week_print_events ($cache_fh, $events2, $use_now_wday, $year, $week, \@weekdays);
- print $cache_fh "<TR>\n";
- week_print_events ($cache_fh, $events3, $use_now_wday, $year, $week, \@weekdays);
-
- print $cache_fh "</TABLE>\n</CENTER>\n</BODY>";
-
- if (defined $main::DATA_ID && $main::DATA_ID)
- {
- # Now the cache should exist, so retry (someone may have removed it meanwhile, but then we just retry)
- week_cache_write_close ($cache_fh);
- goto sw_check_cache;
- }
-}
-
-sub show_day () {
- my ($day, $month, $week, $year, $wday, $wday_name, $eventsdata, @hours, @thours, $day_ref, $rt);
- my ($now_ref, $now_thcolor, $is_now_day, $hour, $event_ref);
-
- # see if we are given the day or not - if year exists, assume yes
- $year = $::query->{'year'};
- if (! defined $year) {
- my ($now_ref);
- $now_ref = get_now ();
- ($year, $month, $day, $week, $wday) =
- ($now_ref->{'year'}, $now_ref->{'month'}, $now_ref->{'day'}, $now_ref->{'week'}, $now_ref->{'wday'});
- } else {
- $week = $::query->{'week'};
- $wday = $::query->{'wday'};
- }
- $wday_name = $::weekdays[$wday];
-
- ($month, $day) = get_month_day_by_wday_year_week ($wday, $year, $week);
-
- $day_ref = build_day ($year, $week, $wday, $day);
-
- # Build list of events on each hour
- @hours = ();
- for $hour (sort { $a <=> $b } keys %$day_ref) {
- if ($hour == -1)
- {
- for $event_ref (@{$day_ref->{$hour}}) {
- push @{$hours[24]}, $event_ref;
- }
- }
- else
- {
- for $event_ref (@{$day_ref->{$hour}}) {
- push @{$hours[$hour]}, $event_ref;
- }
- }
- }
-
- # Count how many events will be on each row
- my ($max_c, $cols, @rows);
- $max_c = 0;
- @rows = (0) x ($::LAST_HOUR + 1);
- for $hour ($::FIRST_HOUR .. $::LAST_HOUR) {
- if ($hours[$hour]) {
- for $event_ref (@{$hours[$hour]}) {
- my ($lengthmin, $min, $end_hour, $h);
- $lengthmin = $event_ref->{'lengthmin'};
- $min = $event_ref->{'min'};
- $end_hour = $hour + int (($lengthmin + $min - 1) / 60) % 24;
- for $h ($hour .. $end_hour) {
- my ($c);
- $c = ++$rows[$h];
- if ($c > $max_c) {
- $max_c = $c;
- }
- }
- }
- }
- }
- $max_c = 1 if $max_c == 0;
- $cols = $max_c + 1;
-
- $now_ref = get_now ();
- if ($now_ref->{'year'} == $year and $now_ref->{'month'} == $month and $now_ref->{'day'} == $day) {
- $is_now_day = 1;
- } else {
- $is_now_day = 0;
- }
- if ($is_now_day) {
- $now_thcolor = $::NOW_THCOLOR;
- } else {
- $now_thcolor = $::THCOLOR;
- }
-
- my $st = strcal();
- print Socket "<HEAD><META HTTP-EQUIV=refresh CONTENT=\"$::REFRESH_DELAY; url=$::MY_URL/?t=day&year=$year&week=$week&wday=$wday$st\"></HEAD>\n";
- print Socket "<BASE TARGET=fevent>\n";
- print Socket $::H_BODY;
- print Socket "<TABLE BORDER=2 CELLSPACING=0 WIDTH=\"90%\">\n";
- print Socket "<TR><TH WIDTH=10><TH COLSPAN=$max_c WIDTH=\"100%\" BGCOLOR=\"$::THCOLOR\">\n";
- print Socket "<TR><TD COLSPAN=$cols BGCOLOR=\"$now_thcolor\" ALIGN=center><B>", pd_year_month_day ($year, $month, $day), " ", __("$wday_name")."</B>\n";
- if (defined $::READ_ONLY and $::READ_ONLY ne 'true' and clipboard_get ($::REMOTE_USER)) {
- print Socket "&nbsp;&nbsp;<A TARGET=_top HREF=\"$::MY_URL/?t=redraw&view=paste_event&year=$year&week=$week&wday=$wday$st\">[".__("Coller")."]</A>\n";
- }
- print Socket "</TD>\n";
-
- print Socket "<TR><TD BGCOLOR=\"$::THCOLOR\">\n";
- if ($::READ_ONLY ne 'true') {
- print Socket "<A HREF=\"$::MY_URL/?t=add_edit$st",
- "&year=", $year, "&week=", $week, "&wday=", $wday, "&hour=-1\">";
- print Socket "&gt;</A>\n";
- }
- else
- {
- print Socket "&gt;\n";
- }
- print Socket "</TD><TD BGCOLOR=\"$::BG_TDCOLOR\"";
- if ($max_c > 1)
- {
- print Socket "COLSPAN=\"$max_c\"";
- }
- print Socket "><table width=100% cellpadding=0 cellspacing=0 border=0>\n";
- my $isev = 0;
- my $sthour;
- my $sttime;
- for $hour (0 .. $::FIRST_HOUR-1, $::LAST_HOUR+1 .. 25)
- {
- if ($hours[$hour])
- {
- $isev = 1;
- my (@events, $event_ref);
- @events = @{$hours[$hour]};
- for $event_ref (@events) {
- my ($id, $min, $title, $data, $lengthmin, $rcolor, $rcolor_end);
- my ($startyear, $startweek, $startwday, $duration);
- my ($alval, $altype, $alchk, $strike);
- $id = $event_ref->{'id'};
- $min = $event_ref->{'min'};
- $lengthmin = $event_ref->{'lengthmin'};
- $title = $event_ref->{'title'};
- $data = $event_ref->{'data'};
- $rt = $event_ref->{'rt'};
- $startyear = $event_ref->{'startyear'};
- $startweek = $event_ref->{'startweek'};
- $startwday = $event_ref->{'startwday'};
- $duration = $event_ref->{'duration'};
- $alval = $event_ref->{'alval'} || 0;
- $altype = $event_ref->{'altype'} || 0;
- $alchk = $event_ref->{'alchk'} || "";
- $strike = $event_ref->{'strike'} || 0;
-
- if ($rt eq 'w') {
- $rcolor = "<FONT COLOR=\"$::REPEAT_WEEK_TEXTCOLOR\">";
- $rcolor_end = "</FONT>";
- } elsif ($rt eq 'm') {
- $rcolor = "<FONT COLOR=\"$::REPEAT_MONTH_TEXTCOLOR\">";
- $rcolor_end = "</FONT>";
- } else {
- $rcolor = $rcolor_end = '';
- }
-
- if ($hour == 24)
- {
- $sthour = -1;
- $sttime = "";
- }
- else
- {
- $sthour = $hour;
- $sttime = "<b>".format_time($hour, $min)." - ".format_time(int($hour + ($min + $lengthmin)/60) % 24, ($min + $lengthmin) % 60)."</b> ";
- }
-
- print Socket '<TR><TD BGCOLOR="'.$::EVENT_COLS[$event_ref->{'cal'} || 0].'" ROWSPAN=', int (($lengthmin + $min + 59) / 60) % 24, "><FONT SIZE=2>",
- "<P><A HREF=\"$::MY_URL/?t=event&id=", $id,
- "&year=", $year, "&week=", $week, "&wday=", $wday,
- "&hour=", $sthour, "&min=", $min,
- "&lengthmin=", $lengthmin,
- "&title=", url_encode ($title),
- "&data=", url_encode ($data),
- "&rt=", $rt,
- "&startyear=", $startyear,
- "&startweek=", $startweek,
- "&startwday=", $startwday,
- "&duration=", $duration,
- "&alval=", $alval,
- "&altype=", $altype,
- "&alchk=", $alchk,
- "&strike=", $strike,
- "$st\">", $rcolor,
- $strike ? "<strike><i>" : "",
- $sttime, $title,
- $strike ? "</i></strike>" : "",
- $rcolor_end, "</A>",
- img_note($data), img_alarm($alval, $altype, $alchk), "</TD></TR>\n";
- }
- }
- }
- print Socket "</table>";
- if (!$isev)
- {
- print Socket "&nbsp;\n";
- }
- print Socket "</TD></TR>\n";
-
- for $hour ($::FIRST_HOUR .. $::LAST_HOUR) {
-
- #
- # Print hour
- #
- print Socket "<TR><TD BGCOLOR=\"$::THCOLOR\"><FONT SIZE=2>";
- if ($::READ_ONLY ne 'true') {
- print Socket "<A HREF=\"$::MY_URL/?t=add_edit$st",
- "&year=", $year, "&week=", $week, "&wday=", $wday, "&hour=", $hour, "\">";
- }
- print Socket format_hour_padded ($hour);
- if ($::READ_ONLY ne 'true') {
- print Socket "</A>\n";
- }
-
- #
- # Print events for this hour
- #
- if ($hours[$hour]) {
- my (@events, $event_ref);
- @events = @{$hours[$hour]};
- for $event_ref (@events) {
- my ($id, $min, $title, $data, $lengthmin, $rcolor, $rcolor_end);
- my ($startyear, $startweek, $startwday, $duration);
- my ($alval, $altype, $alchk, $strike);
- $id = $event_ref->{'id'};
- $min = $event_ref->{'min'};
- $lengthmin = $event_ref->{'lengthmin'};
- $title = $event_ref->{'title'};
- $data = $event_ref->{'data'};
- $rt = $event_ref->{'rt'};
- $startyear = $event_ref->{'startyear'};
- $startweek = $event_ref->{'startweek'};
- $startwday = $event_ref->{'startwday'};
- $duration = $event_ref->{'duration'};
- $alval = $event_ref->{'alval'} || 0;
- $altype = $event_ref->{'altype'} || 0;
- $alchk = $event_ref->{'alchk'} || "";
- $strike = $event_ref->{'strike'} || 0;
-
- if ($rt eq 'w') {
- $rcolor = "<FONT COLOR=\"$::REPEAT_WEEK_TEXTCOLOR\">";
- $rcolor_end = "</FONT>";
- } elsif ($rt eq 'm') {
- $rcolor = "<FONT COLOR=\"$::REPEAT_MONTH_TEXTCOLOR\">";
- $rcolor_end = "</FONT>";
- } else {
- $rcolor = $rcolor_end = '';
- }
- print Socket '<TD BGCOLOR="'.$::EVENT_COLS[$event_ref->{'cal'} || 0].'" ROWSPAN=', int (($lengthmin + $min + 59) / 60) % 24, "><FONT SIZE=2>",
- "<P><A HREF=\"$::MY_URL/?t=event&id=", $id,
- "&year=", $year, "&week=", $week, "&wday=", $wday,
- "&hour=", $hour, "&min=", $min,
- "&lengthmin=", $lengthmin,
- "&title=", url_encode ($title),
- "&data=", url_encode ($data),
- "&rt=", $rt,
- "&startyear=", $startyear,
- "&startweek=", $startweek,
- "&startwday=", $startwday,
- "&duration=", $duration,
- "&alval=", $alval,
- "&altype=", $altype,
- "&alchk=", $alchk,
- "&strike=", $strike,
- "$st\">", $rcolor,
- $strike ? "<strike><i>" : "",
- $title,
- $strike ? "</i></strike>" : "",
- $rcolor_end, "</A>",
- img_note($data), img_alarm($alval, $altype, $alchk), "\n";
- }
- }
- print Socket "<TD BGCOLOR=\"$::BG_TDCOLOR\">&nbsp;" x ($max_c - $rows[$hour]), "\n";
- }
-sd_end:
- print Socket "</TABLE></CENTER>\n</BODY>\n";
-}
-
-sub show_event () {
- my ($year, $month, $day, $week, $wday, $wday_name, $weekdata, @hours, $day_ref, $rt);
- my ($hour, $min, $lengthmin, $title, $data, $endhour, $endmin, $id, $is_now, $now_thcolor, $rcolor);
- my ($startyear, $startweek, $startwday, $duration);
- my ($alval, $altype, $alchk, $strike);
-
- $id = $::query->{'id'};
- $year = $::query->{'year'};
- $week = $::query->{'week'};
- $wday = $::query->{'wday'} || 0;
- $wday_name = $::weekdays[$wday];
- $hour = $::query->{'hour'} || 0;
- $min = $::query->{'min'} || 0;
- $lengthmin = $::query->{'lengthmin'} || 0;
- $title = $::query->{'title'};
- $data = $::query->{'data'};
- $rt = $::query->{'rt'};
- $is_now = $::query->{'is_now'};
- $startyear = $::query->{'startyear'};
- $startweek = $::query->{'startweek'};
- $startwday = $::query->{'startwday'};
- $duration = $::query->{'duration'};
- $alval = $::query->{'alval'} || 0;
- $altype = $::query->{'altype'} || 0;
- $alchk = $::query->{'alchk'} || "";
- $strike = $::query->{'strike'} || 0;
-
- if (! defined $year or ! defined $title) {
- my ($n);
- $n = get_now ();
- show_other_views ($n->{'year'}, $n->{'week'});
- return;
- }
-
- ($month, $day) = get_month_day_by_wday_year_week ($wday, $year, $week);
-
- $endhour = int ($hour + ($min + $lengthmin) / 60) % 24;
- $endmin = int (($min + $lengthmin) % 60);
-
- print Socket $::H_BODY;
-
- if ($is_now) {
- $now_thcolor = $::NOW_THCOLOR;
- } else {
- $now_thcolor = $::THCOLOR;
- }
- if ($rt eq 'w') {
- $rcolor = "COLOR=\"$::REPEAT_WEEK_TEXTCOLOR\"";
- } elsif ($rt eq 'm') {
- $rcolor = "COLOR=\"$::REPEAT_MONTH_TEXTCOLOR\"";
- } else {
- $rcolor = '';
- }
-
- print Socket "<CENTER>\n<TABLE BORDER=1 COLS=1 CELLPADDING=10 ALIGN=center VALIGN=middle WIDTH=\"80%\" BGCOLOR=\"$::TDCOLOR\">\n";
- print Socket "<TR><TH ALIGN=center BGCOLOR=\"$now_thcolor\">".__("Tâche le")." ", pd_event_date ($rt, $startyear, $startweek, $startwday, $duration);
- print Socket "\n<TR><TD BGCOLOR=\"$::TDCOLOR\" ALIGN=left>\n";
- my ($stk1, $stk2) = $strike ? ("<strike><i>","</i></strike>") : ("","");
- if ($hour == -1)
- {
- printf Socket "<P><CENTER><FONT SIZE=\"4\" $rcolor><B>$stk1$title$stk2";
- }
- else
- {
- printf Socket "<P><CENTER><FONT SIZE=\"4\" $rcolor><B>$stk1%s - %s $title$stk2", format_time ($hour, $min), format_time ($endhour, $endmin);
- }
- print Socket (($rt eq 'w') ? ' ('.__("hebdomadaire").')' : ( ( $rt eq 'm' ) ? ' ('.__("mensuelle").')' : '' ));
- print Socket "</B></FONT>", txt_alarm($alval, $altype, $alchk), "</CENTER>\n";
- print Socket "<P>$data\n";
- print Socket "</TABLE>\n";
- my $st = strcal();
-
- if ($::READ_ONLY ne 'true') {
- my ($enc_title, $enc_data);
- $enc_title = url_encode ($title);
- $enc_data = url_encode ($data);
- my $stk3 = $strike ? __("Activer") : __("Désactiver");
- print Socket "<A HREF=\"$::MY_URL/?t=add_edit&id=$id&year=$year&week=$week&wday=$wday&hour=$hour&min=$min&lengthmin=$lengthmin&title=$enc_title&data=$enc_data&rt=$rt&startyear=$startyear&startweek=$startweek&startwday=$startwday&duration=$duration&alval=$alval&altype=$altype&alchk=$alchk&strike=$strike$st\">",
- "[".__("Editer")."]</A>\n";
- print Socket "&nbsp;&nbsp;&nbsp;<A TARGET=\"_top\" HREF=\"$::MY_URL/?t=redraw&view=after_remove_event&id=$id&year=$year&week=$week&wday=$wday&hour=$hour&title=$enc_title&data=$enc_data&rt=$rt&min=$min&lengthmin=$lengthmin&startyear=$startyear&startweek=$startweek&startwday=$startwday&duration=$duration&alval=$alval&altype=$altype&alchk=$alchk&strike=$strike$st\">",
- "[".__("Couper")."]</A>\n";
- print Socket "&nbsp;&nbsp;&nbsp;<A HREF=\"$::MY_URL/?t=copy_event&id=$id&year=$year&week=$week&wday=$wday&hour=$hour&min=$min&lengthmin=$lengthmin&title=$enc_title&data=$enc_data&rt=$rt&startyear=$startyear&startweek=$startweek&startwday=$startwday&duration=$duration&alval=$alval&altype=$altype&alchk=$alchk&strike=$strike$st\">",
- "[".__("Copier")."]</A>\n";
- print Socket "&nbsp;&nbsp;&nbsp;<A TARGET=\"_top\" HREF=\"$::MY_URL/?t=redraw&view=after_delete_event&id=$id&year=$year&week=$week&wday=$wday&hour=$hour&title=$enc_title&data=$enc_data&rt=$rt&min=$min&lengthmin=$lengthmin&startyear=$startyear&startweek=$startweek&startwday=$startwday&duration=$duration&alval=$alval&altype=$altype&alchk=$alchk&strike=$strike$st\">",
- "[".__("Supprimer")."]</A>\n";
- print Socket "&nbsp;&nbsp;&nbsp;<A TARGET=\"_top\" HREF=\"$::MY_URL/?t=redraw&view=after_strike_event&id=$id&year=$year&week=$week&wday=$wday&hour=$hour&title=$enc_title&data=$enc_data&rt=$rt&min=$min&lengthmin=$lengthmin&startyear=$startyear&startweek=$startweek&startwday=$startwday&duration=$duration&alval=$alval&altype=$altype&alchk=$alchk&strike=$strike$st\">",
- "[$stk3]</A>\n";
- }
- print Socket "</CENTER></BODY>\n";
-}
-
-sub add_edit_event_ask () {
- my ($id, $year, $month, $day, $week, $wday, $wday_name, $weekdata, @hours, $day_ref);
- my ($hour, $min, $lengthmin, $title, $data, $endhour, $endmin, $rt, $duration);
- my ($startyear, $startweek, $startwday, $startmonth, $startday);
- my ($endyear, $endweek, $endwday, $endmonth, $endday);
-
- $id = $::query->{'id'} || '';
- $year = $::query->{'year'};
- $week = $::query->{'week'};
- $wday = $::query->{'wday'};
- $wday_name = $::weekdays[$wday];
- $hour = $::query->{'hour'};
- $min = $::query->{'min'} || 0;
- $lengthmin = $::query->{'lengthmin'};
- $rt = $::query->{'rt'} || 'n';
- $title = $::query->{'title'} || '';
- $data = $::query->{'data'} || '';
- $startyear = $::query->{'startyear'} || $year;
- $startweek = $::query->{'startweek'} || $week;
- $startwday = defined $::query->{'startwday'} ? $::query->{'startwday'} : $wday;
- $duration = $::query->{'duration'} || 1;
- my $strike = $::query->{'strike'} || 0;
-
- ($month, $day) = get_month_day_by_wday_year_week ($wday, $year, $week);
-
-
- if ($id) {
- if ($hour == -1)
- {
- $endhour = -1;
- $endmin = -1;
- }
- else
- {
- $endhour = int ($hour + ($min + $lengthmin) / 60) % 24;
- $endmin = int (($min + $lengthmin) % 60);
- }
- } else {
- $endhour = $hour+1;
- $endmin = 0;
- }
-
- ($startmonth, $startday, $endyear, $endweek, $endwday, $endmonth, $endday) =
- get_start_end_by_year_week_wday_duration ($startyear, $startweek, $startwday, $duration);
-
- print Socket $::H_BODY;
- print Socket "<CENTER>\n";
- print Socket "<TABLE BORDER=1 COLS=1 CELLPADDING=3 ALIGN=center WIDTH=\"100%\" BGCOLOR=\"$::TDCOLOR\">\n";
- print Socket "<TR><TH ALIGN=center BGCOLOR=\"$::THCOLOR\"><B>";
- if ($id) {
- print Socket __("Editer tâche");
- } else {
- print Socket __("Ajouter tâche");
- }
- print Socket " ".pd_event_date ($rt, $startyear, $startweek, $startwday, $duration);
- print Socket "</B></TH></TR>\n";
- print Socket "<TR><TD BGCOLOR=\"$::TDCOLOR\">\n";
-
- print Socket "<CENTER><TABLE BORDER=0 BGCOLOR=\"$::TDCOLOR\" CELLSPACING=0 CELLPADDING=0>\n\n";
-
- print Socket "<FORM TARGET=_top ACTION=\"$::MY_URL\" METHOD=GET>\n";
- print Socket "<INPUT TYPE=HIDDEN NAME=oldrt VALUE=$rt>\n";
- print Socket "<INPUT TYPE=HIDDEN NAME=oldhour VALUE=$hour>\n";
- print Socket "<INPUT TYPE=HIDDEN NAME=oldduration VALUE=$duration>\n";
- print Socket "<INPUT TYPE=HIDDEN NAME=year VALUE=$year>\n";
- print Socket "<INPUT TYPE=HIDDEN NAME=week VALUE=$week>\n";
- print Socket "<INPUT TYPE=HIDDEN NAME=wday VALUE=$wday>\n";
- print Socket "<INPUT TYPE=HIDDEN NAME=startyear VALUE=$startyear>\n";
- print Socket "<INPUT TYPE=HIDDEN NAME=startweek VALUE=$startweek>\n";
- print Socket "<INPUT TYPE=HIDDEN NAME=startwday VALUE=$startwday>\n";
-
- print Socket "<INPUT TYPE=HIDDEN NAME=t VALUE=redraw>\n";
- print Socket "<INPUT TYPE=HIDDEN NAME=view VALUE=add_event>\n";
- print Socket "<INPUT TYPE=HIDDEN NAME=id VALUE=$id>\n";
- print Socket "<INPUT TYPE=HIDDEN NAME=strike VALUE=$strike>\n";
-
- # Event time
- print Socket "<TR><TD ALIGN=left>\n";
- print Socket __("Heure début")."</TD><TD><SELECT NAME=hour1>\n";
- print Socket "<OPTION VALUE=-1 ", ($hour == -1 ? 'SELECTED' : ''), ">\n";
- for (0 .. 23) {
- print Socket "<OPTION VALUE=$_ ", (($_ == $hour) ? 'SELECTED' : ''), ">", format_hour_padded ($_), "\n";
- }
- print Socket "</SELECT>\n";
- print Socket "<SELECT NAME=min1>\n";
- print Socket "<OPTION VALUE=-1 ", ($min == -1 ? 'SELECTED' : ''), ">\n";
- for (qw (00 15 30 45)) {
- print Socket "<OPTION VALUE=$_ ", (($_ == $min) ? 'SELECTED' : ''), ">$_\n";
- }
- print Socket "</SELECT>\n";
- print Socket " - \n";
- print Socket "<SELECT NAME=hour2>\n";
- print Socket "<OPTION VALUE=-1 ", ($endhour == -1 ? 'SELECTED' : ''), ">\n";
- for (0 .. 23) {
- print Socket "<OPTION VALUE=$_ ", (($_ == $endhour) ? 'SELECTED' : ''), ">", format_hour_padded ($_), "\n";
- }
- print Socket "</SELECT>\n";
- print Socket "<SELECT NAME=min2>\n";
- print Socket "<OPTION VALUE=-1 ", ($endmin == -1 ? 'SELECTED' : ''), ">\n";
- for (qw (00 15 30 45)) {
- print Socket "<OPTION VALUE=$_ ", (($_ == $endmin) ? 'SELECTED' : ''), ">$_\n";
- }
- print Socket "</SELECT>\n</TD></TR>\n";
-
- # Duration (days)
- print Socket "<TR><TD>".__("Durée")."</TD><TD><SELECT NAME=duration>\n";
- for (1 .. $::MAX_DURATION) {
- print Socket "<OPTION VALUE=$_ ", (($_ == $duration) ? 'SELECTED' : ''), ">$_ ", ($_ == 1 ? __("jour") : __("jours")), "\n";
- }
- print Socket "</SELECT>\n";
-
- # Repeat
- my ($sn, $sw, $sm);
- $sn = $sw = $sm = '';
- if ($rt eq 'n') {
- $sn = 'SELECTED';
- } elsif ($rt eq 'w') {
- $sw = 'SELECTED';
- } elsif ($rt eq 'm') {
- $sm = 'SELECTED';
- }
- print Socket "<SELECT NAME=rt>";
- print Socket "<OPTION VALUE=n $sn>".__("Sans répétition");
- print Socket "<OPTION VALUE=w $sw>".__("Répéter toutes les semaines");
- print Socket "<OPTION VALUE=m $sm>".__("Répéter tous les mois");
- print Socket "</SELECT>\n</TD></TR>\n";
-
- # Alarm
- print Socket "<TR><TD ALIGN=left>".__("Alarme")."</TD>";
- my $alval = $::query->{'alval'} || 0;
- print Socket "<TD><SELECT NAME=alval>\n";
- for (0 .. 23) {
- print Socket "<OPTION VALUE=$_ ", (($_ == $alval) ? 'SELECTED' : ''), ">", ($_) ? $_ : '' ,"\n";
- }
- print Socket "</SELECT>\n";
- my $altype = $::query->{'altype'} || 0;
- print Socket "<SELECT NAME=altype>\n";
- for (0 .. 3) {
- print Socket "<OPTION VALUE=$_ ", (($_ == $altype) ? 'SELECTED' : ''), ">".format_alarm_type($_)."\n";
- }
- my $alchk = $::query->{'alchk'} || "";
- print Socket "</SELECT>\n";
- print Socket '<INPUT TYPE="checkbox" NAME="alchk" VALUE="'.$alchk.'"';
- if ($alchk)
- {
- print Socket ' CHECKED';
- }
- print Socket "> ".__("lancée");
- print Socket "</TD>\n";
-
- # Title
- print Socket "<TR><TD ALIGN=left>".__("Titre")."</TD><TD>";
- print Socket "<INPUT SIZE=51 NAME=title VALUE=\"", html_to_newline ($title), "\"></TD></TR>";
-
- # Data
- print Socket "<TR><TD ALIGN=left COLSPAN=2><TEXTAREA ROWS=", ($::SCREEN_RESOLUTION eq '800x600' ? 2 : 4) ," COLS=58 NAME=\"data\">", html_to_newline ($data), "</TEXTAREA></TD></TR>";
- print Socket "</TABLE>\n";
-
- # Submit
- my ($submit_value);
- $submit_value = ($id ? __("Valider") : __("Ajouter"));
- print Socket "<INPUT TYPE=submit VALUE=\"$submit_value\">\n";
- print Socket "</FORM></CENTER>\n";
-
- print Socket "</TABLE>\n";
-
- print Socket "</FORM></CENTER>\n";
- print Socket "</BODY>\n";
-
-}
-
-sub print_event_error_start () {
- print Socket $::H_BODY;
- print Socket "<DIV ALIGN=center VALIGN=middle>\n";
- print Socket "<TABLE BORDER=1 CELLPADDING=10 ALIGN=center VALIGN=middle BGCOLOR=\"$::TDCOLOR\" WIDTH=\"80%\">\n<TR><TD><BR><BR>\n\n";
-}
-
-sub print_event_error_end () {
- print Socket "<BR><BR></TABLE>\n</BODY>\n";
-}
-
-sub day_index ($$$$) {
- my ($rt, $year, $week, $wday) = @_;
- my ($index);
-
- # Index by day or wday, depending on repeat type
- if ($rt eq 'n' or $rt eq 'w') {
- $index = $wday + 0;
- } else {
- my ($month, $day);
- ($month, $day) = get_month_day_by_wday_year_week ($wday, $year, $week);
- $index = $day + 0;
- }
-
- return $index;
-}
-
-# Read, update, and write new highest event id into general database
-# Return the (id, possible error or false)
-sub next_id () {
- my ($id, $gendata, $err);
-
- $gendata = read_general ();
- if (! ref $gendata eq 'HASH') {
- $err = $gendata;
- return ('', $err);
- }
-
- $id = $gendata->{'highid'} + 1;
- $gendata->{'highid'} = $id;
-
- $err = write_general ($gendata);
- if ($err) {
- return ('', $err);
- }
- return ($id, '');
-}
-
-sub remove_events ($$$$$$$) {
- my ($rt, $year, $week, $wday, $duration, $hour, $id) = @_;
- my ($i);
-
- for $i (0 .. $duration - 1) {
- my ($cyear, $cweek, $cwday, $index_day, $hour_ref, $eventsdata, @hour, $err);
-
- ($cyear, $cweek, $cwday) = get_year_week_wday_by_year_week_wday_plus_days ($year, $week, $wday, $i);
-
- $index_day = day_index ($rt, $cyear, $cweek, $cwday);
-
-
- $eventsdata = read_events ($rt, $cyear, $cweek);
- $hour_ref = $eventsdata->[$index_day]->{$hour};
- if (ref $hour_ref eq 'ARRAY') {
- my ($i);
- @hour = @$hour_ref;
- for $i (0 .. $#hour) {
- if ($hour[$i]->{'id'} == $id) {
- splice (@hour, $i, 1);
- goto re_found;
- }
- }
- }
- return "internal error: the event isn't in the database (user ${main::DATA_ID}, year $cyear, week $cweek, wday $cwday, id $id, rt $rt)";
-
-re_found:
- if (@hour) {
- $eventsdata->[$index_day]->{$hour+0} = \@hour;
- } else {
- # no events left for this hour, so remove whole hour
- delete $eventsdata->[$index_day]->{$hour};
- }
- $err = write_events ($eventsdata, $rt, $cyear, $cweek);
- if ($err) {
- return $err;
- }
- }
- return '';
-}
-
-sub add_events {
- my ($rt, $year, $week, $wday, $duration, $hour, $id, $min, $lengthmin, $title, $data, $alval, $altype, $alchk, $strike) = @_;
- my ($i, $err);
-
- if (!$alval)
- {
- $alval = 0;
- }
- if (!$altype)
- {
- $altype = 0;
- }
- if (!$alchk)
- {
- $alchk = "";
- }
- if (!$strike)
- {
- $strike = 0;
- }
- # Figure out the new $id
- if (! $id) {
- my ($gendata);
-
- # Read, update, and write new highest event id into general database
- $gendata = read_general ();
- if (! ref $gendata eq 'HASH') {
- $err = $gendata;
- return $err;
- }
- $id = $gendata->{'highid'} + 1;
- $gendata->{'highid'} = $id;
- $err = write_general ($gendata);
- if ($err) {
- return $err;
- }
- }
-
-
- for $i (0 .. $duration - 1) {
- my ($cyear, $cweek, $cwday, $index_day, $eventsdata);
-
-
- ($cyear, $cweek, $cwday) = get_year_week_wday_by_year_week_wday_plus_days ($year, $week, $wday, $i);
-
-
- $index_day = day_index ($rt, $cyear, $cweek, $cwday);
-
- # Read events, add, write back
- $eventsdata = read_events ($rt, $cyear, $cweek);
- push @{$eventsdata->[$index_day]->{$hour+0}},
- {
- 'id' => $id + 0,
- 'min' => $min + 0,
- 'lengthmin' => $lengthmin + 0,
- 'title' => $title,
- 'data' => $data,
- 'rt' => $rt,
- 'startyear' => $year + 0,
- 'startweek' => $week + 0,
- 'startwday' => $wday + 0,
- 'duration' => $duration + 0,
- 'alval' => $alval + 0,
- 'altype' => $altype + 0,
- 'alchk' => $alchk,
- 'strike' => $strike,
- };
-
- $err = write_events ($eventsdata, $rt, $cyear, $cweek);
- if ($err) {
- return $err;
- }
-
- }
- return '';
-}
-
-sub add_event_commit () {
- my ($id, $year, $month, $day, $week, $wday, $wday_name, $rt);
- my ($hour1, $min1, $hour2, $min2, $lengthmin, $title, $data, $endhour, $endmin);
- my ($err, $i);
- my ($oldrt, $oldhour);
- my ($oldhour_ref, @hour, $oldduration, $duration);
- my ($startyear, $startweek, $startwday, $startmonth, $startday);
- my ($alval, $altype, $alchk, $strike);
-
- $oldrt = $::query->{'oldrt'};
- $oldhour = $::query->{'oldhour'};
- $oldduration = $::query->{'oldduration'};
-
- $id = $::query->{'id'} || '';
- $year = $::query->{'year'};
- $week = $::query->{'week'};
- $wday = $::query->{'wday'};
- $startyear = $::query->{'startyear'};
- $startweek = $::query->{'startweek'};
- $startwday = $::query->{'startwday'};
- $duration = $::query->{'duration'};
-
- $hour1 = $::query->{'hour1'};
- $min1 = $::query->{'min1'};
- $hour2 = $::query->{'hour2'};
- $min2 = $::query->{'min2'};
- $rt = $::query->{'rt'};
- $title = strip_space $::query->{'title'};
- $data = strip_space $::query->{'data'} || '';
-
- $alval = $::query->{'alval'} || 0;
- $altype = $::query->{'altype'} || 0;
- $alchk = $::query->{'alchk'} || "";
- $strike = $::query->{'strike'} || 0;
-
- ($startmonth, $startday) = get_month_day_by_wday_year_week ($startwday, $startyear, $startweek);
-
- if ($hour1 == -1)
- {
- $min1 = -1;
- $hour2 = -1;
- $min2 = -1;
- $lengthmin = -1;
- }
- else
- {
- $lengthmin = $hour2*60 + $min2 - $hour1*60 - $min1;
- }
-
- if (! defined $title or ! $title) {
- return "The title of the event must be entered.";
- } elsif (! &ParseDate ("$startmonth/$startday/$startyear")) {
- return "Date $startday.$startmonth.$startyear is invalid."
- } elsif ($duration < 1 or $duration > $::MAX_DURATION) {
- return "You chose impossible duration \"$duration\"."
- } elsif ($rt eq 'w' and ! fit_in_week ($startyear, $startweek, $startwday, $duration)) {
- return "Weekly repeating event must fit entirely in one week."
- } elsif ($rt eq 'm' and ! fit_in_month ($startyear, $startweek, $startwday, $duration)) {
- return "Monthly repeating event must fit entirely in one month (the month you placed it in specifically)."
- } elsif ($rt ne 'n' and $rt ne 'w' and $rt ne 'm') {
- return "You chose impossible repeat type \"$rt\"."
- } elsif (has_html $title or has_html $data) {
- return "Text contains one more more of the illegal characters <, > and &."
- } elsif ($lengthmin <= 0 && $hour1 != -1) {
- return "The start of the event ($hour1:$min1) must be before its end ($hour2:$min2)."
- }
-
- $title = newline_to_html $title;
- $data = newline_to_html $data;
-
- #
- # Remove the old event. The old one only exists if $id is set so this is
- # an edit command.
- #
-
- if ($id) {
- $err = remove_events ($oldrt, $startyear, $startweek, $startwday, $oldduration, $oldhour, $id);
- if ($err) {
- return $err;
- }
- }
-
- #
- # Figure out the new $id
- #
- if (! $id) {
- ($id, $err) = next_id ();
- if ($err) {
- return $err;
- }
- }
-
- #
- # Add event for each day
- #
-
- $err = add_events ($rt, $startyear, $startweek, $startwday, $duration, $hour1, $id,
- $min1, $lengthmin, $title, $data, $alval, $altype, $alchk, $strike);
- if ($err) {
- return $err;
- }
- #
- # When we get here, add has been succesful.
- #
- # Return the id and some other items to redraw(), since he doesn't know
- # them otherwise.
- #
- return { 'id' => $id, 'lengthmin' => $lengthmin, 'data' => $data, 'title' => $title };
-}
-
-sub remove_event_commit ($$$$$$$$$$$$$$) {
- my ($year, $week, $wday, $id, $hour, $rt, $min, $lengthmin, $title, $data, $startyear, $startweek, $startwday, $duration) = @_;
- my ($err);
-
- if (! defined $id or ! defined $week or ! defined $wday or ! defined $rt or ! defined $duration) {
- return "some data of the event to be removed not given";
- }
-
- #
- # Copy data into clipboard
- #
- clipboard_set ($::REMOTE_USER,
- { 'hour' => $hour, 'min' => $min, 'lengthmin' => $lengthmin,
- 'title' => $title, 'data' => $data, 'rt' => $rt,
- 'startyear' => $startyear, 'startweek' => $startweek, 'startwday' => $startwday, 'duration' => $duration } );
-
- #
- # Remove the event from the database
- #
- $err = remove_events ($rt, $startyear, $startweek, $startwday, $duration, $hour, $id);
- if ($err) {
- return $err;
- }
-
- return '';
-}
-
-sub delete_event_commit ($$$$$$$$$$$$$$) {
- my ($year, $week, $wday, $id, $hour, $rt, $min, $lengthmin, $title, $data, $startyear, $startweek, $startwday, $duration) = @_;
- my ($err);
-
- if (! defined $id or ! defined $week or ! defined $wday or ! defined $rt or ! defined $duration) {
- return "some data of the event to be removed not given";
- }
-
- #
- # Remove the event from the database
- #
- $err = remove_events ($rt, $startyear, $startweek, $startwday, $duration, $hour, $id);
- if ($err) {
- return $err;
- }
-
- return '';
-}
-
-sub switch_strike_event_commit {
- my ($year, $week, $wday, $id, $hour, $rt, $min, $lengthmin, $title, $data, $startyear, $startweek, $startwday, $duration, $alval, $altype, $alchk, $strike) = @_;
- my ($err);
-
- if (! defined $id or ! defined $week or ! defined $wday or ! defined $rt or ! defined $duration) {
- return "some data of the event to be striked not given";
- }
-
- #
- # Strike/unstrike the event in the database
- #
-
- $strike = 1 - $strike;
- $err = remove_events ($rt, $startyear, $startweek, $startwday, $duration, $hour, $id);
- if ($err) { return $err; }
- $err = add_events ($rt, $startyear, $startweek, $startwday, $duration, $hour, $id, $min, $lengthmin, $title, $data, $alval, $altype, $alchk, $strike);
- if ($err) { return $err; }
- return '';
-}
-
-sub copy_event () {
- my ($hour, $min, $lengthmin, $title, $data, $rt, $startyear, $startweek, $startwday, $duration);
-
- $hour = $::query->{'hour'};
- $min = $::query->{'min'};
- $lengthmin = $::query->{'lengthmin'};
- $title = $::query->{'title'};
- $data = $::query->{'data'};
- $rt = $::query->{'rt'};
- $startyear = $::query->{'startyear'};
- $startweek = $::query->{'startweek'};
- $startwday = $::query->{'startwday'};
- $duration = $::query->{'duration'};
-
- return if ! check_write_access ();
-
- clipboard_set ($::REMOTE_USER,
- { 'hour' => $hour, 'min' => $min, 'lengthmin' => $lengthmin,
- 'title' => $title, 'data' => $data, 'rt' => $rt,
- 'startyear' => $startyear, 'startweek' => $startweek, 'startwday' => $startwday, 'duration' => $duration } );
-
- # Show_even() re-reads the variables from %$::query
- show_event ();
-}
-
-sub paste_event_commit ($$$) {
- my ($year, $week, $wday) = @_;
- my ($event_ref, $err, $id);
-
-
- # Read the event data from clipboard
- $event_ref = clipboard_get ($::REMOTE_USER);
- if (! $event_ref) {
- return "There is no event in clipboard for your computer $::REMOTE_USER.";
- }
-
- #
- # Find new id
- #
- ($id, $err) = next_id ();
- if ($err) {
- return $err;
- }
-
- #
- # Update some fields
- #
-
- $event_ref->{'startyear'} = $year;
- $event_ref->{'startweek'} = $week;
- $event_ref->{'startwday'} = $wday;
- $event_ref->{'id'} = $id;
-
- #
- # Make some sanity checks
- #
-
- my ($startmonth, $startday, $startyear, $startweek, $startwday, $duration, $rt);
- ($startmonth, $startday) = get_month_day_by_wday_year_week ($wday, $year, $week);
- $startyear = $year; $startweek = $week; $startwday = $wday;
- $duration = $event_ref->{'duration'};
- $rt = $event_ref->{'rt'};
-
- if (! &ParseDate ("$startmonth/$startday/$startyear")) {
- return "Date $startday.$startmonth.$startyear is invalid."
- } elsif ($rt eq 'w' and ! fit_in_week ($startyear, $startweek, $startwday, $duration)) {
- return "Weekly repeating event must fit entirely in one week."
- } elsif ($rt eq 'm' and ! fit_in_month ($startyear, $startweek, $startwday, $duration)) {
- return "Monthly repeating event must fit entirely in one month (the month you placed it in, specifically)."
- }
-
- #
- # Add event for each day
- #
-
-
- $err = add_events (
- $event_ref->{'rt'},
- $event_ref->{'startyear'},
- $event_ref->{'startweek'},
- $event_ref->{'startwday'},
- $event_ref->{'duration'},
- $event_ref->{'hour'},
- $event_ref->{'id'},
- $event_ref->{'min'},
- $event_ref->{'lengthmin'},
- $event_ref->{'title'},
- $event_ref->{'data'} );
- if ($err) {
- return $err;
- }
-
- # When we get here, add has been succesful
- return $event_ref;
-}
-
-sub xxx_event_error () {
- my ($error1, $error2);
- $error1 = $::query->{'error1'};
- $error2 = $::query->{'error2'};
-
- print Socket $::H_BODY;
- print Socket "<DIV ALIGN=center VALIGN=middle>\n";
- print Socket "<TABLE BORDER=3 ROWS=1 COLS=1 CELLPADDING=20 ALIGN=center VALIGN=middle WIDTH=\"70%\" BGCOLOR=$::ERROR_COLOR>\n";
- print Socket "<TR><TD ALIGN=center VALIGN=middle>\n";
- print Socket "<H1>$error1</H1>\n";
- print Socket "<P>$error2\n</TD></TR>";
- print Socket "</TABLE>\n";
- print Socket "</BODY>\n";
- return;
-}
-
-sub show_event_list () {
- my ($year, $week, $alldata_ref, $lastweek);
- my ($cweek, $cyear, $cmonth, $cday, $end_cmonth, $end_cday);
- my ($now_ref, $now_year, $now_week, $now_wday, $week_ref, $wday, $hour);
-
- $year = $::query->{'year'};
- $week = $::query->{'week'};
-
- $alldata_ref = build_week_list ($year, $week);
- if (ref $alldata_ref ne 'ARRAY') {
- print Socket "<DIV ALIGN=center VALIGN=middle><H1>Listing events failed: $alldata_ref</H1></DIV>\n";
- return;
- }
-
- $now_ref = get_now ();
- ($now_year, $now_week, $now_wday) = ($now_ref->{'year'}, $now_ref->{'week'}, $now_ref->{'wday'});
-
- print Socket $::H_BODY;
-
- print Socket "<PRE>\n</PRE>\n<P>\n";
- print Socket "<TABLE BORDER=1 WIDTH=\"100%\">\n";
- my $str = sprintf(__("Tâches depuis la semaine %d de l'année %d"), $week, $year);
- print Socket "<TR><TH COLSPAN=3 BGCOLOR=\"$::THCOLOR\"><FONT SIZE=\"+1\">$str\n";
- print Socket "<TR><TH COLSPAN=3>\n";
-
- my $st = strcal();
- $lastweek = -1;
- for $week_ref (@$alldata_ref) {
- for $wday (0..6) {
- for $hour (sort {$a <=> $b} keys %{$week_ref->[0]->[$wday]}) {
- my ($event_ref);
- $cyear = $week_ref->[1];
- $cweek = $week_ref->[2];
-
- # Change of week
- if ($cweek != $lastweek) {
- my ($b_month, $b_day, $e_month, $e_day, $color);
- $lastweek = $cweek;
- ($b_month, $b_day) = get_month_day_by_firstday_year_week ($cyear, $cweek);
- ($e_month, $e_day) = get_month_day_by_wday_year_week (6, $cyear, $cweek);
- if ($cyear == $now_year and $cweek == $now_week) {
- $color = $::NOW_TDCOLOR;
- } else {
- $color = $::TDCOLOR;
- }
- print Socket "<TR><TD COLSPAN=3 BGCOLOR=\"$color\"><A TARGET=_top HREF=\"$::MY_URL/?t=redraw&view=week&year=$cyear&week=$cweek$st\"><B>".sprintf(__("Semaine %s"), $cweek).", ", pd_year_month_day ($cyear, $b_month, $b_day), " - ", pd_year_month_day ($cyear, $e_month, $e_day), "</B></A>\n";
- }
-
- for $event_ref (@{$week_ref->[0]->[$wday]->{$hour}}) {
- my (%e, $hour1, $min1, $hour2, $min2, $lengthmin);
- my ($tmonth, $tday, $twday, $id, $min, $title, $data, $rt, $day, $color, $rcolor);
- my ($startyear, $startweek, $startwday, $duration);
- %e = %$event_ref;
- $hour1 = $hour;
- $id = $e{'id'};
- $min1 = $e{'min'};
- $lengthmin = $e{'lengthmin'};
- $title = $e{'title'};
- $data = $e{'data'};
- $rt = $e{'rt'};
- $startyear = $event_ref->{'startyear'};
- $startweek = $event_ref->{'startweek'};
- $startwday = $event_ref->{'startwday'};
- $duration = $event_ref->{'duration'};
-
- $hour2 = ($hour1 + int (($min1+$lengthmin) / 60)) % 24;
- $min2 = ($min1 + $lengthmin) % 60;
- ($cmonth, $cday) = get_month_day_by_wday_year_week ($wday, $cyear, $cweek);
- if ($cyear == $now_year and $cweek == $now_week and $wday == $now_wday) {
- $color = " BGCOLOR=\"$::NOW_TDCOLOR\"";
- } else {
- $color = " BGCOLOR=\"$::BG_TDCOLOR\"";
- }
-
- if ($rt eq 'w') {
- $rcolor = "COLOR=\"$::REPEAT_WEEK_TEXTCOLOR\"";
- } elsif ($rt eq 'm') {
- $rcolor = "COLOR=\"$::REPEAT_MONTH_TEXTCOLOR\"";
- } else {
- $rcolor = '';
- }
- print Socket "<TR><TD$color><A TARGET=_top HREF=\"$::MY_URL/?t=redraw&view=event$st",
- "&id=", $id,
- "&year=", $cyear, "&week=", $cweek, "&wday=", $wday,
- "&hour=", $hour,
- "&min=", $min1,
- "&lengthmin=", $lengthmin,
- "&title=", url_encode ($title),
- "&data=", url_encode ($data),
- "&rt=", $rt,
- "&startyear=", $startyear,
- "&startweek=", $startweek,
- "&startwday=", $startwday,
- "&duration=", $duration,
- "\"><FONT $rcolor SIZE=\"2\">";
- printf Socket "<TT>%s %s - %s</TT></A>\n",
- __($::weekdays_short[$wday]),
- format_time_padded ($hour1, $min1),
- format_time_padded ($hour2, $min2);
- print Socket "</FONT><TD BGCOLOR=\"$::BG_TDCOLOR\"><FONT SIZE=\"2\">", $e{'title'}, "</FONT><TD BGCOLOR=\"$::BG_TDCOLOR\"><FONT SIZE=\"2\">", $data || "&nbsp;", "</FONT>\n";
- }
- }
- }
- }
- print Socket "</TABLE><BR CLEAR=all>\n";
-
- return;
-}
-
-sub show_other_views (;$$) {
- my ($year, $week) = @_;
- my ($month, $moffset);
-
- $year = $year || $::query->{'year'};
- $week = $week || $::query->{'week'};
-
- print Socket $::H_BODY;
-
- print Socket "<CENTER>\n<TABLE BORDER=1 CELLPADDING=5 ALIGN=center VALIGN=middle WIDTH=\"95%\" BGCOLOR=\"$::TDCOLOR\">\n";
- print Socket "<TR><TH ALIGN=center BGCOLOR=\"$::THCOLOR\"><B>".__("Autres vues")."</B>";
- print Socket "\n<TR><TD BGCOLOR=\"$::TDCOLOR\" ALIGN=left>\n";
- print Socket "<TABLE><TR>\n";
- print Socket "<TD><UL><FONT SIZE=2>\n";
- my $str = sprintf(__("Agendas %s"), $::ORGANIZATION);
- my $st = strcal();
- print Socket "<LI><A TARGET=_top HREF=\"$::BASE_URL/\">$str</A>\n";
- $str = sprintf(__("Tâches depuis la semaine %d de l'année %d"), $week, $year);
- print Socket "<LI><A HREF=\"$::MY_URL/?t=event_list&year=$year&week=$week$st\">$str</A>";
- print Socket "</FONT></UL></TD>\n";
- print Socket "<TD><UL><FONT SIZE=2>\n";
- $str = sprintf(__("Purger l'agenda jusqu'à la semaine %d de l'année %d"), , $week, $year);
- if (!$st && $::USER !~ /^\wo_/ && -e "/dev/pilot")
- {
- print Socket "<LI><A HREF=\"$::MY_URL/?t=purge&year=$year&week=$week\">$str</A>";
- }
- print Socket "</FONT></UL></TD>\n";
- print Socket "</TR></TABLE>\n";
-
- print Socket "<CENTER><TABLE BORDER=1 COLS=$::MANY_WEEKS_HOR WIDTH=\"98%\" BGCOLOR=\"$::BG_TDCOLOR\">\n";
- my ($cyear, $cweek, $cmonth, $cday, $now_year, $now_week, $n);
- $n = get_now ();
- $now_year = $n->{'year'}; $now_week = $n->{'week'};
- ($cyear, $cweek) = get_year_week_by_firstday_year_week_minus_days ($year, $week,
- ($::MANY_WEEKS_VERT * $::MANY_WEEKS_HOR + int ($::MANY_WEEKS_HOR / 2)) * 7);
- for $moffset (-$::MANY_WEEKS_VERT .. $::MANY_WEEKS_VERT) {
- my ($m);
- print Socket "<TR>\n";
- for $m (0 .. $::MANY_WEEKS_HOR-1) {
- ($cmonth, $cday) = get_month_day_by_firstday_year_week ($cyear, $cweek);
- if ($cweek == $now_week and $cyear == $now_year) {
- printf Socket "<TD BGCOLOR=\"$::NOW_TDCOLOR\"><FONT SIZE=2><A TARGET=fweek HREF=\"$::MY_URL/?t=week&year=$cyear&week=$cweek$st\">%02d : %s</A></FONT></TD>\n", $cweek, pd_month_day_padded ($cmonth, $cday);
- } else {
- printf Socket "<TD><FONT SIZE=2><A TARGET=fweek HREF=\"$::MY_URL/?t=week&year=$cyear&week=$cweek$st\">%02d : %s</A></FONT></TD>\n", $cweek, pd_month_day_padded ($cmonth, $cday);
- }
- $cweek++;
- if ($cweek > 50) {
- $cweek--;
- ($cyear, $cweek) = get_next_year_week ($cyear, $cweek);
- }
- }
- print Socket "</TR>\n";
- }
- print Socket "</TABLE></CENTER>\n";
-
- print Socket "</TABLE>\n";
- print Socket "</CENTER>\n</BODY>\n";
- return;
-}
-
-sub redraw_print_frameset ($$$) {
- my ($tweek, $tday, $tevent) = @_;
- my ($top_y, $left_x);
-
- if ($::SCREEN_RESOLUTION eq '800x600') {
- $top_y = 200;
- $left_x = 250;
- } else {
- $top_y = 250;
- $left_x = 320
- }
-
- my $title = sprintf(__("Agenda %s"), $::LONG_NAME);
- my $st = "";
- if ($::query->{'cal'})
- {
- $st .= "&cal=".join("&cal=", split(/\n/, $::query->{'cal'}));
- }
-
- print Socket <<END;
-<HEAD><TITLE>$title</TITLE></HEAD>
-<frameset framespacing="0" border="false" rows="$top_y,*" frameborder="0">
-frameborder="0" marginheight="0" marginwidth="3" name="fhead" scrolling="no" target="fday" noresize>
-<frame src="$tweek$st" bordercolor="#ffffff"
-frameborder="0" marginheight="3" marginwidth="3" name="fweek" scrolling="auto" target="fday" noresize>
-<frameset cols="$left_x,*">
-<frame src="$tday$st" frameborder="0" marginheight="3"
-marginwidth="3" name="fday" scrolling="auto" target="fevent" noresize>
-<frame src="$tevent$st" frameborder="0" marginheight="3"
-marginwidth="3" name="fevent" scrolling="auto" noresize>
-</frameset>
-<noframes>
-<body>
-</body>
-</noframes>
-</frameset>
-END
- return;
-}
-
-sub check_write_access () {
- if ($::READ_ONLY eq 'true') {
- print Socket $::H_BODY;
- print Socket "<CENTER><TABLE BORDER=2 COLS=1 CELLPADDING=5 WIDTH=\"80%\" ALIGN=center VALIGN=middle BGCOLOR=\"$::ERROR_COLOR\">\n";
- print Socket "<TR><TD><BGCOLOR=\"$::THCOLOR\">&nbsp;<P><CENTER><FONT COLOR=\"#ffffff\" SIZE=4><B>This user has no write permission.</B></FONT></CENTER><P>&nbsp;</TD></TR>\n";
- print Socket "</TABLE></CENTER>\n";
- print Socket "</BODY>\n";
- return 0;
- }
- return 1;
-}
-
-sub redraw () {
- my ($view, $id, $year, $week, $wday, $wday_name);
- my ($hour, $min, $lengthmin, $title, $data, $rt);
- my ($tweek, $tday, $tevent);
- my ($startyear, $startweek, $startwday, $duration);
- my ($alval, $altype, $alchk, $strike);
-
- $view = $::query->{'view'};
- $id = $::query->{'id'};
- $year = $::query->{'year'};
- $week = $::query->{'week'};
- $wday = $::query->{'wday'} || 0;
- $wday_name = $::weekdays[$wday];
- $hour = $::query->{'hour'};
- $min = $::query->{'min'};
- $lengthmin = $::query->{'lengthmin'};
- $title = $::query->{'title'};
- $data = $::query->{'data'};
- $rt = $::query->{'rt'} || 'n';
- $startyear = $::query->{'startyear'};
- $startweek = $::query->{'startweek'};
- $startwday = $::query->{'startwday'};
- $duration = $::query->{'duration'};
- $alval = $::query->{'alval'};
- $altype = $::query->{'altype'};
- $alchk = $::query->{'alchk'} || "";
- $strike = $::query->{'strike'} || 0;
-
- if (! defined $view or $view eq '' or $view eq 'default') {
- $tweek = "$::MY_URL/?t=week";
- $tday = "$::MY_URL/?t=day";
- $tevent = "$::MY_URL/?t=event";
- redraw_print_frameset ($tweek, $tday, $tevent);
- } elsif ($view eq 'week') {
- $tweek = "$::MY_URL/?t=week&year=$year&week=$week";
- $tday = "$::MY_URL/?t=day";
- $tevent = "$::MY_URL/?t=event";
- redraw_print_frameset ($tweek, $tday, $tevent);
- } elsif ($view eq 'event') {
- $tweek = "$::MY_URL/?t=week&year=$year&week=$week";
- $tday = "$::MY_URL/?t=day&year=$year&week=$week&wday=$wday";
- $tevent = "$::MY_URL/?t=event&id=$id&year=$year&week=$week&wday=$wday&hour=$hour&min=$min&lengthmin=$lengthmin&title=" . url_encode ($title) . "&data=" . url_encode ($data) . "&rt=$rt&startyear=$startyear&startweek=$startweek&startwday=$startwday&duration=$duration";
- redraw_print_frameset ($tweek, $tday, $tevent);
- } elsif ($view eq 'after_remove_event') {
- my ($err);
- return if ! check_write_access ();
- $err = remove_event_commit ($year, $week, $wday, $id, $hour, $rt, $min, $lengthmin, $title, $data, $startyear, $startweek, $startwday, $duration);
- $tweek = "$::MY_URL/?t=week&year=$year&week=$week";
- $tday = "$::MY_URL/?t=day&year=$year&week=$week&wday=$wday&rt=$rt";
- if ($err) {
- $tevent = "$::MY_URL/?t=xxx_event_error&error1=" . url_encode ("Error removing event") . "&error2=" . (url_encode $err);
- } else {
- $tevent = "$::MY_URL/?t=event";
- }
- redraw_print_frameset ($tweek, $tday, $tevent);
- } elsif ($view eq 'after_delete_event') {
- my ($err);
- return if ! check_write_access ();
- $err = delete_event_commit ($year, $week, $wday, $id, $hour, $rt, $min, $lengthmin, $title, $data, $startyear, $startweek, $startwday, $duration);
- $tweek = "$::MY_URL/?t=week&year=$year&week=$week";
- $tday = "$::MY_URL/?t=day&year=$year&week=$week&wday=$wday&rt=$rt";
- if ($err) {
- $tevent = "$::MY_URL/?t=xxx_event_error&error1=" . url_encode ("Error removing event") . "&error2=" . (url_encode $err);
- } else {
- $tevent = "$::MY_URL/?t=event";
- }
- redraw_print_frameset ($tweek, $tday, $tevent);
- } elsif ($view eq 'paste_event') {
- my ($err);
- return if ! check_write_access ();
- $err = paste_event_commit ($year, $week, $wday);
- $tweek = "$::MY_URL/?t=week&year=$year&week=$week";
- $tday = "$::MY_URL/?t=day&year=$year&week=$week&wday=$wday&rt=$rt";
- if (ref $err ne 'HASH') {
- $tevent = "$::MY_URL/?t=xxx_event_error&error1=" . url_encode ("Error pasting event from clipboard") . "&error2=" . (url_encode $err);
- } else {
- $tevent = "$::MY_URL/?t=event&id=" . $err->{'id'} . "&year=$year&week=$week&wday=$wday&hour=" . $err->{'hour'} . "&min=" . $err->{'min'} . "&lengthmin=" . $err->{'lengthmin'} . "&title=" . url_encode ($err->{'title'}) . "&data=" . url_encode ($err->{'data'}) . "&rt=" . $err->{'rt'} . "&startyear=" . $err->{'startyear'} . "&startweek=" . $err->{'startweek'} . "&startwday=" . $err->{'startwday'} . "&duration=" . $err->{'duration'};
- }
- redraw_print_frameset ($tweek, $tday, $tevent);
- } elsif ($view eq 'add_event') {
- my ($err);
- return if ! check_write_access ();
- $err = add_event_commit ();
- $tweek = "$::MY_URL/?t=week&year=$year&week=$week";
- $tday = "$::MY_URL/?t=day&year=$year&week=$week&wday=$wday&rt=$rt";
- if (ref $err ne 'HASH') {
- $tevent = "$::MY_URL/?t=xxx_event_error&error1=" . url_encode ("Error adding an event") . "&error2=" . (url_encode $err);
- } else {
- $tevent = "$::MY_URL/?t=event&id=" . $err->{'id'} . "&year=$year&week=$week&wday=$wday&hour=" . $::query->{'hour1'} . "&min=" . $::query->{'min1'} . "&lengthmin=" . $err->{'lengthmin'} . "&title=" . url_encode ($err->{'title'}) . "&data=" . url_encode ($err->{'data'}) . "&rt=$rt&startyear=$startyear&startweek=$startweek&startwday=$startwday&duration=$duration&alval=$alval&altype=$altype&alchk=$alchk&strike=$strike";
- }
- redraw_print_frameset ($tweek, $tday, $tevent);
- } elsif ($view eq 'after_strike_event') {
- my ($err);
- return if ! check_write_access ();
- $err = switch_strike_event_commit ($year, $week, $wday, $id, $hour, $rt, $min, $lengthmin, $title, $data, $startyear, $startweek, $startwday, $duration, $alval, $altype, $alchk, $strike);
- $tweek = "$::MY_URL/?t=week&year=$year&week=$week";
- $tday = "$::MY_URL/?t=day&year=$year&week=$week&wday=$wday&rt=$rt";
- if ($err) {
- $tevent = "$::MY_URL/?t=xxx_event_error&error1=" . url_encode ("Error striking event") . "&error2=" . (url_encode $err);
- } else {
- $strike = 1 - $strike;
- $tevent = "$::MY_URL/?t=event&id=$id&year=$year&week=$week&wday=$wday&hour=$hour&min=$min&lengthmin=$lengthmin&title=" . url_encode ($title) . "&data=" . url_encode ($data) . "&rt=$rt&startyear=$startyear&startweek=$startweek&startwday=$startwday&duration=$duration&alval=$alval&altype=$altype&alchk=$alchk&strike=$strike";
- }
- redraw_print_frameset ($tweek, $tday, $tevent);
- } else {
- print Socket "<CENTER><H1>Redraw: Unknown view \"$view\".\n";
- }
- return;
-}
-
-sub create_users () {
- my (@users, $user);
-
- if (! chdir ($::DIRECTORY)) {
- return "Can't change into directory $::DIRECTORY: $!<P>Make sure it exists, and its permissions are as explained in file INSTALL of the Wcal distribution.";
- }
-
- @users = sort (keys (%$::USER_CONFS));
- for $user (@users) {
- my ($desc);
- $desc = $::USER_CONFS->{$user}->{'long name'};
- if (-d $user and -M $user > -M $::CONF_FILE) {
- system "/bin/rm -rf $user";
- }
- if (! -d $user) {
- my ($access_file, $access_file_name);
- if (! mkdir ($user, 0755)) {
- return "Internal error: can't create user '$user': $!";
- }
- if (! link ('index.cgi', $user . '/index.cgi')) {
- return "Internal error: can't create hard link 'index.cgi -> $user/index.cgi': $!";
- }
- $access_file_name = $::USER_CONFS->{$user}->{'access file name'};
- $access_file = $::USER_CONFS->{$user}->{'access file'};
- if ($access_file and $access_file_name) {
- if (! open (AF, ">$user/$access_file_name")) {
- return "Internal error: can't create access file $user/$access_file_name: $!";
- }
- print AF "# This file is automatically generated from $::CONF_FILE - do not edit\n";
- print AF $access_file;
- close AF;
- }
- }
- }
- return '';
-}
-
-# Removes all cache files.
-sub purge_cache_all () {
- my (@files);
- if (! opendir (DIR, "$::DB_DIR/cache")) {
- return;
- }
- @files = grep { /^w-[^-]+-\d\d\d\d\d\d\.html$/ } readdir (DIR);
- closedir DIR;
- for (@files) {
- unlink "$::DB_DIR/cache/$_" or warn "can't remove $::DB_DIR/cache/$_: $!\n";
- }
-}
-
-# Removes cached week views and Date::Manip wrapper caches.
-# Supposed to be called at first request after midnight.
-sub purge_cache_newday () {
- my (@files);
- my ($now_ref, $foo, $week1, $week2);
-
- #
- # Cached dates.
- # Other date caches stay valid accross date change.
- #
-
- undef $::now_cache;
-
- #
- # Cached week for this week, or all weeks if the week has changed
- #
- $now_ref = get_now ();
- $week1 = sprintf ("%02d", $now_ref->{'week'});
- ($foo, $week2) = get_prev_year_week ($now_ref->{'year'}, $week1);
- $week2 = sprintf ("%02d", $week2);
-
- if (! opendir (DIR, "$::DB_DIR/cache")) {
- return;
- }
- if ($week1 == $week2) {
- @files = grep { /^w-[^-]+-\d\d\d\d$week1\.html$/ } readdir (DIR);
- } else {
- @files = grep { /^w-[^-]+-\d\d\d\d\d\d\.html$/ } readdir (DIR);
- }
- closedir DIR;
- for (@files) {
- unlink "$::DB_DIR/cache/$_" or warn "can't remove $::DB_DIR/cache/$_: $!\n";
- }
-
- return;
-}
-
-# Create socket and make it listen
-sub init_socket () {
- if (! socket (SSocket, PF_INET, SOCK_STREAM, getprotobyname('tcp')) ) {
- print STDERR "$0: can't create socket: $!";
- exit 1;
- }
-
- if (! setsockopt(SSocket, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) ) {
- print STDERR "$0: can't set socketopt SO_REUSEADDR: $!";
- exit 1;
- }
-
- if (! bind(SSocket, sockaddr_in($::PORT, INADDR_ANY)) ) {
- print STDERR "$0: can't bind socket to INADDR_ANY: $!";
- exit 1;
- }
-
- if (! listen(SSocket, SOMAXCONN) ) {
- print STDERR "$0: can't make socket listen: $!";
- exit 1;
- }
-}
-
-sub parse_config_line ($) {
- my ($line) = @_;
- my ($key, $value);
-
- if ($line =~ /^#/ or $line =~ /^\s*$/) {
- return '';
- }
- if ($line =~ /=/) {
- ($key, $value) = split (/=/, $_, 2);
- } else {
- ($key, $value) = ($_, '');
- }
- $key =~ s/^\s*(.*?)\s*$/$1/;
- $key = lc $key;
- $key =~ tr/ \t/ /s;
- if ($key !~ /^[a-z0-9_ ]+$/) {
- return "Config file line $. key '$key' has invalid characters";
- }
- $value =~ s/^\s*(.*?)\s*$/$1/;
- return {'key' => $key, 'value' => $value};
-}
-
-sub import_settings ($) {
- my ($s_ref) = @_;
- $::PASSWORD = $s_ref->{'password'};
- $::PORT = $s_ref->{'port'};
- $::BASE_URL = $s_ref->{'base url'};
- $::IMG_URL = $::BASE_URL . '/images';
- $::ORGANIZATION = $s_ref->{'organization'};
- $::LONG_NAME = $s_ref->{'long name'};
- $::READ_ONLY = $s_ref->{'read only'};
- $::DATA_ID = $s_ref->{'data id'};
- $::FIRST_DAY = $s_ref->{'first day'};
- $::DATE_FORMAT = $s_ref->{'date format'};
- $::CLOCK = $s_ref->{'clock'};
- $::SCREEN_RESOLUTION = $s_ref->{'screen resolution'};
-
- $::MY_URL = $::BASE_URL . "/" . (defined $::USER ? $::USER.'/index.cgi' : 'index.cgi');
- $::MY_URL_XUSER = $::BASE_URL . "/" . (defined $::USER ? 'X_USER_X/index.cgi' : 'index.cgi');
- $::REMOTE_LANG = $s_ref->{'remote lang'} || "en";
- $::REMOTE_MAIL = $s_ref->{'remote mail'} || "root";
- $::REMOTE_CAL = $s_ref->{'remote cal'} || "all";
-
- $::H_BODY = "<BODY BGCOLOR=\"#ffffff\" TEXT=\"#000000\" LINK=\"#0000b0\" VLINK=\"#0000b0\" ALINK=\"#0000b0\" BACKGROUND=\"$::BASE_URL/images/background.jpg\">\n";
- return;
-}
-
-# Reads global config data from /etc/wcal.conf
-sub read_config () {
- my ($key, $value, $line, $line_ref, %global_conf, %user_confs, $cuser, $conf_ref);
- my (@current_access_file, $reading_access_file);
- my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
- my ($valid_line);
-
- if (! open (CONF, "<$::CONF_FILE")) {
- my $str1 = "can't open $::CONF_FILE for reading: $!";
- return \$str1;
- }
-
- # Conf file must not be read/writeable by 'other'
- ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat (CONF);
- if ($mode & 6) {
- close CONF;
- my $str2 = "Configuration file $::CONF_FILE must not have read or write permission for 'other' (do 'chmod o= $::CONF_FILE)'.\n";
- return \$str2;
- }
-
- # Empty the settings from the last run
- %global_conf = (); %user_confs = ();
- $conf_ref = \%global_conf;
- $cuser = '';
- $reading_access_file = 0;
-
- # Set some defaults
- $global_conf{'host'} = 'localhost';
- $global_conf{'port'} = '13134';
- $global_conf{'base url'} = '/wcal';
- $global_conf{'access file name'} = '.htaccess';
- $global_conf{'access file'} = '';
- $global_conf{'organization'} = 'My Organization';
- $global_conf{'read only'} = 'false';
- $global_conf{'first day'} = 'monday';
- $global_conf{'date format'} = 1;
- $global_conf{'clock'} = '24-hour';
- $global_conf{'screen resolution'} = '1024x768';
- $global_conf{'top left corner'} = '&nbsp;';
- $global_conf{'remote lang'} = 'en';
- $global_conf{'remote mail'} = 'root';
- $global_conf{'remote cal'} = 'all';
-
- while (<CONF>) {
- chomp;
- $line = $_;
-
- # If we are reading access file, do special processing
- if ($reading_access_file) {
- $line =~ s/^\s*(.*?)\s*$/$1/;
- if ($line =~ /^end access file$/i) {
- $conf_ref->{'access file'} = join ("\n", @current_access_file) . "\n";
- $reading_access_file = 0;
- } else {
- push @current_access_file, $line;
- }
- next;
- }
-
- # Else do the normal processing
-
- $line_ref = parse_config_line ($line);
- next if ! $line_ref; # skip comments and empty lines
- if (! ref $line_ref) { # if return value not empty, and not a reference, it's an error
- close CONF;
- return \$line_ref;
- }
- $key = $line_ref->{'key'};
- $value = $line_ref->{'value'};
-
- # 'user' field starts user definition
- if ($key eq 'user') {
- if (! defined $global_conf{'password'}) {
- close CONF;
- my $str2 = "Configuration file $::CONF_FILE line $. starts user definition, but the password field hasn't yet occured (password must be given in global section before any user definitions)";
- return \$str2;
- }
- $cuser = $value;
- $conf_ref = {};
- next;
- }
-
- # 'end user' field ends user definition
- if ($key eq 'end user') {
- my ($gkey);
- # Copy each global conf field into user definition if it isn't given in user definition
- for $gkey (keys %global_conf) {
- if (! defined $conf_ref->{$gkey}) {
- $conf_ref->{$gkey} = $global_conf{$gkey};
- }
- }
- # Long name = user, if not explicitely given
- if (! defined $conf_ref->{'long name'}) {
- $conf_ref->{'long name'} = $cuser;
- }
- # Data id = user, if not explicitely given
- if (! defined $conf_ref->{'data id'}) {
- $conf_ref->{'data id'} = $cuser;
- }
- # Empty 'top left corner' replaced with &nbsp;, to make browsers happier.
- if ($conf_ref->{'top left corner'} eq '') {
- $conf_ref->{'top left corner'} = '&nbsp;';
- }
- $user_confs{$cuser} = $conf_ref;
- $cuser = '';
- $conf_ref = \%global_conf;
- next;
- }
-
- # 'access file' starts (default / user) access file definition
- if ($key eq 'access file') {
- if ($value) {
- close CONF;
- my $str3 = "Configuration file $::CONF_FILE line $. starts access file definition, but has value field";
- return \$str3;
- }
- @current_access_file = ();
- $reading_access_file = 1;
- next;
- }
-
- $valid_line = 0;
-
- # Some fields can only occur in global section
- if ($cuser and ($key eq 'port' or $key eq 'address')) {
- close CONF;
- my $str4 = "Configuration file $::CONF_FILE line $. has in user $cuser definition parameter '$key' that can only occur in global section";
- return \$str4;
- }
-
- # And some only in user definition
- if (! $cuser and ($key eq 'long name' or $key eq 'read only')) {
- close CONF;
- my $str5 = "Configuration file $::CONF_FILE line $. has in global section parameter '$key' that can only occur in user definition";
- return \$str5;
- }
-
- # READ ONLY field can have only values true or false
- if ($key eq 'read only') {
- $value = lc $value;
- if ($value ne 'true' and $value ne 'false') {
- close CONF;
- my $str6 = "Configuration file $::CONF_FILE line $. has invalid value for option 'read only'. Allowed values are true and false (default false).";
- return \$str6;
- }
- $valid_line = 1;
- }
-
- # FIRST DAY can be only monday or sunday
- elsif ($key eq 'first day') {
- if ($value ne 'monday' and $value ne 'sunday') {
- close CONF;
- my $str7 = "Configuration file $::CONF_FILE line $. has invalid value for option 'first day'. Allowed values are monday and sunday (default monday).";
- return \$str7;
- }
- $value = lc $value;
- $valid_line = 1;
- }
-
- # DATE FORMAT must be between 1 and 5
- elsif ($key eq 'date format') {
- if ($value < 1 or $value > 6) {
- close CONF;
- my $str8 = "Configuration file $::CONF_FILE line $. has invalid value for option 'date format'. Allowed values are 1 to 6 (default 1).";
- return \$str8;
- }
- $valid_line = 1;
- }
-
- # PORT must be a integer number
- elsif ($key eq 'port') {
- if ($value !~ /^\d+$/ or $value < 1 or $value > 65535) {
- close CONF;
- my $str9 = "Configuration file $::CONF_FILE line $. has invalid value for option 'port'. Allowed values are integer numbers between 1 and 65535 (default 13134).";
- return \$str9;
- }
- $valid_line = 1;
- }
-
- # CLOCK must be 24-hour or 12-hour
- elsif ($key eq 'clock') {
- $value = lc $value;
- if ($value ne '24-hour' and $value ne '12-hour') {
- close CONF;
- my $str10 = "Configuration file $::CONF_FILE line $. has invalid value for option 'clock'. Allowed values are '24-hour' and '12-hour' (default 24-hour).";
- return \$str10;
- }
- $valid_line = 1;
- }
-
- # SCREEN RESOLUTION must be 800x600 or 1024x768
- elsif ($key eq 'screen resolution') {
- $value = lc $value;
- if ($value ne '800x600' and $value ne '1024x768') {
- close CONF;
- my $str11 = "Configuration file $::CONF_FILE line $. has invalid value for option 'screen resolution'. Allowed values are '800x600' and '1024x768' (default 1024x768).";
- return \$str11;
- }
- $valid_line = 1;
- }
-
- # DATABASE DIRECTORY is deprecated
- elsif ($key eq 'database directory') {
- print STDERR "Configuration variable 'database directory' is deprecated and won't be used.";
- print STDERR "If you have database in a place other than $::DB_DIR, move it there now.";
- $valid_line = 1;
- }
-
- # OTHERS - no particular syntax required, but must be a valid key
- elsif ($key eq 'base url' or $key eq 'password' or
- $key eq 'organization' or $key eq 'access file name' or $key eq 'data id' or
- $key eq 'long name' or $key eq 'address' or $key eq 'top left corner' or
- $key eq 'lang' or $key eq 'remote lang' or $key eq 'remote mail' or $key eq 'remote cal' or $key eq 'install dir') {
- $valid_line = 1;
- }
-
- if (! $valid_line) {
- close CONF;
- my $str12 = "Configuration file $::CONF_FILE line $. has unknown option '$key'.";
- return \$str12;
- }
-
- $conf_ref->{$key} = $value;
- }
- close CONF;
- if ($reading_access_file or $cuser) {
- my $str13 = "End of configuration file $::CONF_FILE while reading access file or user definition";
- return \$str13;
- }
-
- $::GLOBAL_CONF = \%global_conf;
- $::USER_CONFS = \%user_confs;
-
- import_settings ($::GLOBAL_CONF);
-
- purge_cache_all ();
-
- return 1;
-}
-
-# Read CGI environment and conf option from Socket (sent by the cgi-proxy)
-sub read_environment () {
- my ($key, $value, $user);
-
- while (<Socket>) {
- chomp;
- last if /^$/;
- my ($key, $value);
-
- ($key, $value) = split (/=/, $_, 2);
- $key =~ tr/\x00-\x1f\x80-\x9f//d; # filter out control characters,
- $value =~ tr/\x00-\x1f\x80-\x9f//d; # including infamous NUL
- if ($key eq 'QUERY_STRING') {
- $::query = decode_url_encoded_data \$value;
- } elsif ($key eq 'REMOTE_USER') {
- $::REMOTE_USER = $value;
- $ENV{REMOTE_USER} = $::REMOTE_USER;
- } elsif ($key eq 'REMOTE_PASS') {
- $::REMOTE_PASS = $value;
- $ENV{REMOTE_PASS} = $::REMOTE_PASS;
- } elsif ($key eq 'REMOTE_MAIL') {
- $::REMOTE_MAIL = $value;
- } elsif ($key eq 'REMOTE_CAL') {
- $::REMOTE_CAL = $value;
- } elsif ($key eq 'REMOTE_LANG') {
- $::REMOTE_LANG = $value;
- } elsif ($key =~ /^__/) {
- $key = lc $key;
- if ($key eq '__password') {
-# print Socket "<P>got: '$value', correct is '$::PASSWORD'\n";
- if ($value ne $::PASSWORD) {
- print Socket "<P>Invalid password\n";
- return 0;
- }
- } elsif ($key eq '__user') {
- $::USER = $value;
- } elsif ($key eq '__gid') {
- $::GID = $value;
- } else {
- print Socket "<P>Unknown configuration option '$key'\n";
- return 0;
- }
- }
- }
-# print Socket "<P>$::MY_URL\n";
-
- # Make sure we received all the mandatory options
- if (! $::USER) {
- print Socket "<P>User not sent by cgi-proxy\n";
- return 0;
- }
- return 1;
-}
-
-sub siginthandler {
- exit (1);
-}
-
-sub sighuphandler {
- my ($res);
-
- return; # do nothing, this is just a kludge that doesn't work
-
- $::GID = 60;
- $res = read_config ();
- if (ref $res) {
- print STDERR "<P>Re-reading configureation failed: ", $$res, " - configuration not changed.\n";
- } else {
- $res = create_users ();
- if ($res) {
- print STDERR "<P>Error creating new users: $res\n";
- }
- }
-
- return;
-}
-
-sub check_and_set_first_day () {
- my ($gen);
-
- $gen = read_general ();
- if (! ref $gen) {
- print "error: $gen\n";
- exit (1);
- }
- if (defined $gen->{'first day'} and $gen->{'first day'} ne $::FIRST_DAY) {
- print <<EOD;
-
-Current database ($::DB_DIR/*.db) is created using different 'first day'
-value than defined in current configuration file $::CONF_FILE.
-If you want to change 'first day' setting, you must first destroy the
-current database (by doing 'rm $::DB_DIR/*.db').
-
-EOD
- exit (1);
- }
- if (! defined $gen->{'first day'}) {
- my ($err);
-
- $gen->{'first day'} = $::FIRST_DAY;
- $err = write_general ($gen);
- if ($err) {
- print "error: $err\n";
- exit (1);
- }
- }
- return;
-}
-
-sub show_links () {
- print Socket $::H_BODY;
- my @cals = split(/\n/, $::query->{'cal'});
- my $st = "";
- if ($::query->{'year'} && $::query->{'week'})
- {
- $st = '&year='.$::query->{'year'}.'&week='.$::query->{'week'};
- }
- print Socket '<h1><a href="'.$::BASE_URL.'/fusion.cgi/?t=week&cal='.join("&cal=", @cals).$st;
-
- print Socket '" target="fweek">'.$::LONG_NAME."</a></h1>\n";
- print Socket "<table width=100% border=0 cellspacing=0 cellpadding=5>\n";
- my $cal;
- my $i = 1;
- foreach $cal (@cals)
- {
- print Socket '<tr bgcolor="'.$::EVENT_COLS[$i++].'"><td><font size=4><b><a href="'.$::BASE_URL.'/'.$cal.'/index.cgi/?t=week'.$st.'"target="fweek">'.%{$::USER_CONFS->{$cal}}->{'long name'}."</b></font></a>\n";
- }
- print Socket "</table>";
-}
-
-sub clear_events {
- my $week = shift;
- my $year = shift;
-
- if ($week)
- {
- my $file;
- opendir(DIR, $::DB_DIR);
- while ($file = readdir(DIR))
- {
- if ($file =~ /^w\-$::USER\-(\d\d\d\d)(\d\d)\.db$/)
- {
- if (($1 < $year) || (($1 == $year) && ($2 <= $week)))
- {
- unlink($::DB_DIR."/".$file);
- }
-
- }
- }
- closedir(DIR);
- opendir(DIR, $::DB_DIR."/cache");
- while ($file = readdir(DIR))
- {
- if ($file =~ /^w\-$::USER\-(\d\d\d\d)(\d\d)\.html$/)
- {
- if (($1 < $year) || (($1 == $year) && ($2 <= $week)))
- {
- unlink($::DB_DIR."/cache/".$file);
- }
-
- }
- }
- closedir(DIR);
-
- }
- else
- {
- system('\rm '.$::DB_DIR.'/*'.$::USER.'*');
- system('\rm '.$::DB_DIR.'/cache/*'.$::USER.'*');
- }
-}
-
-sub all_events () {
- opendir(DIR, $::DB_DIR);
- my @events;
- my $event;
- my $evw;
- my $i;
- my $key;
- my $val;
- my $file;
- while ($file = readdir(DIR))
- {
- if ($file =~ /^w\-$::USER\-(\d\d\d\d)(\d\d)\.db$/)
- {
- $evw = read_events('n', $1, $2);
- for ($i=0; $i<7; $i++)
- {
- while (($key, $val) = each(%{@{$evw}[$i]}))
- {
- foreach $event (@{$val})
- {
- $event->{hour} = $key;
- push @events, $event;
- }
- }
- }
- }
- }
-
- return \@events;
-}
-
-sub show_purge () {
- my $str;
- my $week = $::query->{'week'};
- my $year = $::query->{'year'};
-
- print Socket $::H_BODY;
- print Socket "<TABLE BORDER=1 WIDTH=\"100%\" BGCOLOR=\"$::TDCOLOR\">\n";
- print Socket "<TR><TH ALIGN=center BGCOLOR=\"$::THCOLOR\"><B>";
- print Socket __("Transfert Palm Pilot");
- print Socket "</B></TH></TR>\n";
- print Socket "<TR><TD BGCOLOR=\"$::TDCOLOR\">\n";
- if ($::query->{'purge'})
- {
- clear_events($week, $year);
- $str = sprintf(__("Agenda %s purgé jusqu'à la semaine %d de l'année %d"), '<A HREF="'.$::MY_URL.'" TARGET="_top">'.$::LONG_NAME.'</A>', $week, $year);
- print Socket "<H1>$str</H1>\n";
- }
- elsif ($::query->{'cancel'})
- {
- $str = sprintf(__("Purge de l'agenda %s annulée"), '<A HREF="'.$::MY_URL.'" TARGET="_top">'.$::LONG_NAME.'</A>');
- print Socket "<H1>$str</H1>\n";
- }
- else
- {
- print Socket "<TABLE><TR align=center>\n";
- print Socket "<TD colspan=2><h1>".sprintf(__("Voulez-vous réellement purger l'agenda %s jusqu'à la semaine %d de l'année %d ?"), $::LONG_NAME, $::query->{'week'}, $::query->{'year'})."\n";
- print Socket "<TR align=center>\n";
- print Socket "<FORM ACTION=\"$::MY_URL\" METHOD=GET>\n";
- print Socket "<INPUT TYPE=HIDDEN NAME=t VALUE=purge>\n";
- print Socket "<INPUT TYPE=HIDDEN NAME=week VALUE=$::query->{'week'}>\n";
- print Socket "<INPUT TYPE=HIDDEN NAME=year VALUE=$::query->{'year'}>\n";
- my $submit_value = __("Oui");
- print Socket "<TD><INPUT TYPE=submit NAME=purge VALUE=\"$submit_value\">\n";
- $submit_value = __("Non");
- print Socket "<TD><INPUT TYPE=submit NAME=cancel VALUE=\"$submit_value\">\n";
- print Socket "</FORM></TABLE>\n";
- }
- print Socket "</TABLE>\n";
-}
-
-sub checkAlarm
-{
- my $event = shift;
- my $cal = shift;
- my $hour = shift;
- my $day = shift;
- my $et = shift;
- my $week = shift;
- my $year = shift;
-
- my @types = ("", "minutes", "hours" , "days");
- # compute start date
- my $now=&ParseDate("today");
- my $begin;
- my $end;
- my $alarm;
- my $strdate;
- my @format;
- my @tab;
- my $chk = 1;
- my $min = $event->{min};
- my $notime;
- if ($hour == -1)
- {
- $hour = 0;
- $min = 0;
- $notime = 1;
- }
- if ($et eq "w")
- {
- $begin = &DateCalc(&ParseDate(sprintf("%04d-w%02d-%d", $event->{startyear}, $event->{startweek}, $event->{startwday}+1)), sprintf("+%dhours +%dminutes", $hour, $min));
- $alarm = &DateCalc($begin, sprintf("-%d%s", $event->{alval}, $types[$event->{altype}]));
- if ($alarm gt $now)
- {
- return 0;
- }
- }
- elsif ($et eq "rw")
- {
- $alarm = &DateCalc($now, sprintf("+%d%s", $event->{alval}, $types[$event->{altype}]));
- @format = ("%w");
- my $wday = &UnixDate($alarm, @format);
- $wday = 1 + $event->{startwday} - $wday;
- if ($wday > 0)
- {
- return 0;
- }
- elsif ($wday < 0)
- {
- $begin = &DateCalc($alarm, $wday."days");
- }
- else
- {
- $begin = $alarm;
- }
- $begin = substr($begin,0,8).sprintf("%02d:%02d:00", $hour, $min);
- if ($begin gt $alarm || ($event->{alchk} && $begin le $event->{alchk}))
- {
- return 0;
- }
-
- $chk = $begin;
- }
- elsif ($et eq "rm")
- {
- $alarm = &DateCalc($now, sprintf("+%d%s", $event->{alval}, $types[$event->{altype}]));
- @format = ("%d");
- my $mday = &UnixDate($alarm, @format);
- $mday = $day - $mday;
- if ($mday > 0)
- {
- return 0;
- }
- elsif ($mday < 0)
- {
- $begin = &DateCalc($alarm, $mday."days");
- }
- else
- {
- $begin = $alarm;
- }
- $begin = substr($begin,0,8).sprintf("%02d:%02d:00", $hour, $min);
- if ($begin gt $alarm || ($event->{alchk} && $begin le $event->{alchk}))
- {
- return 0;
- }
-
- $chk = $begin;
- }
-
- my $email = "root";
- my $head;
- my $body;
- $email = $::REMOTE_MAIL;
- $head = sprintf(__("Agenda %s"), %{$::USER_CONFS->{$cal}}->{'long name'});
-
- if ($notime)
- {
- @format = ("%d","%m","%y");
- @tab = &UnixDate($begin, @format);
- $strdate = sprintf("%02d/%02d/%02d", @tab);
- }
- else
- {
- @format = ("%d","%m","%y","%H","%M");
- @tab = &UnixDate($begin, @format);
- $strdate = sprintf("%02d/%02d/%02d %02d:%02d", @tab);
- $end = &DateCalc($begin, sprintf("+%dminutes", $event->{lengthmin}));
- @format = ("%H","%M");
- @tab = &UnixDate($end, @format);
- $strdate .= sprintf(" - %02d:%02d", @tab);
- }
- my $data = $event->{data};
- $data =~ s/<BR>/\n\t /mg;
-
- $body = $head."\n";
-
- $head .= " : ".$event->{title}."\n";
- $body .= "************************************************************\n";
- $body .= __("Date")."\t: ".$strdate."\n";
- $body .= __("Titre")."\t: ".$event->{title}."\n";
- if ($data)
- {
- $body .= __("Note")."\t: ".$data."\n";
- }
- $body .= "************************************************************\n";
- system('mail -s "'.$head.'" '.$email." <<EOF\n".$body."\nEOF");
-
- return $chk;
-}
-
-sub check_alarm () {
- opendir(DIR, $::DB_DIR);
- my $file;
- my $et;
- my $cal;
- my $week;
- my $year;
- my $refs;
- my $hour;
- my $day;
- my $devents;
- my $events;
- my $event;
- my $old_slash;
- my $err;
- my $chk;
-
- while ($file = readdir(DIR))
- {
- if ($file =~ /^(\w+)-(.+)\.db$/)
- {
- $et = $1;
- $cal = $2;
- if ($cal =~ /^(.+)-(\d\d\d\d)(\d\d)$/)
- {
- $cal = $1;
- $year = $2;
- $week = $3;
- }
- else
- {
- $year = "";
- $week = "";
- }
- if ($::REMOTE_CAL ne "all" && $::REMOTE_CAL ne $cal)
- {
- next;
- }
- if (open F, "$::DB_DIR/$file")
- {
- $old_slash = $/;
- undef $/;
- $refs = eval (<F>);
- $/ = $old_slash;
- close F;
- shift @$refs;
- $day = 0;
- foreach $devents (@$refs)
- {
- while (($hour,$events) = each (%$devents))
- {
- foreach $event (@$events)
- {
- if ($event->{alval} && !$event->{strike} && (!$event->{alchk} || $event->{alchk} ne "1"))
- {
- if ($chk = checkAlarm($event, $cal, $hour, $day, $et, $week, $year))
- {
- $::USER = $cal;
- $::DATA_ID = $cal;
- print Socket "$event->{'title'} ($event->{'id'}) checked\n";
- $err = remove_events(
- $event->{'rt'},
- $event->{'startyear'},
- $event->{'startweek'},
- $event->{'startwday'},
- $event->{'duration'},
- $hour,
- $event->{'id'});
- if (!$err)
- {
- $err = add_events(
- $event->{'rt'},
- $event->{'startyear'},
- $event->{'startweek'},
- $event->{'startwday'},
- $event->{'duration'},
- $hour,
- $event->{'id'},
- $event->{'min'},
- $event->{'lengthmin'},
- $event->{'title'},
- $event->{'data'},
- $event->{'alval'},
- $event->{'altype'},
- $chk);
- }
- }
- }
- }
- }
- $day++;
- }
- }
- }
- }
- closedir(DIR);
-}
-
-sub list_users () {
- my (@users, $user);
-
- my $str = sprintf(__("Agendas %s"), $::ORGANIZATION);
- print Socket "<HEAD><TITLE>$str</TITLE></HEAD>\n";
- print Socket $::H_BODY;
-
- if (! chdir ($::DIRECTORY)) {
- print Socket "<P>Can't change into directory $::DIRECTORY: $!";
- print Socket "<P>Make sure it exists, and its permissions are as explained in file INSTALL of the Wcal distribution.";
- exit (1);
- }
-
- print Socket "<CENTER><H1>$str</H1></CENTER>";
- print Socket sprintf(__("Cliquez sur un calendrier ou sélectionnez les calendriers pour la %s"), '<a href="fusion-'.$::REMOTE_LANG.'.html">'.__("Fusion")."</a>");
- print Socket '<form action="'.$::BASE_URL.'/fusion.cgi">'."\n";
- print Socket "<P><UL>\n";
- @users = sort (keys (%$::USER_CONFS));
- for $user (@users) {
- my ($desc);
- $desc = $::USER_CONFS->{$user}->{'long name'};
- print Socket '<input type="checkbox" name="cal" value="'.$user.'"> ';
- print Socket "<A TARGET=_top HREF=\"$::BASE_URL/$user/?t=redraw&view=default\">$desc</A><br>\n";
- }
- print Socket "</UL>\n";
- print Socket '<input type="submit" name="fusion" value="'.__("Fusion").'"></form action>'."\n";
- print Socket "</BODY>\n";
- return;
-}
-
-sub main () {
- my ($config_result, $last_run, $last_conf, $res);
-
- $SIG{HUP} = $SIG{PIPE} = 'IGNORE';
- $SIG{ALRM} = \&purge_cache_all;
- $ENV{'PATH'} = '/usr/local/bin:/usr/local/sbin:/usr/bin:/usr/sbin:/bin:/sbin'; # To pass taint checks
-
- #
- # Make sure the $::DIRECTORY variable is set
- #
-
- if ($::DIRECTORY =~ /^_X_DIRECTOR/) {
- print "You haven't set the variable $::DIRECTORY at top of wcald.\n";
- print "It is automatically set by Makefile. If you're installing manually,\n";
- print "set the variable the name directory you installed wcald to.\n";
- exit 1;
- }
-
- #
- # Refuse to run as root
- #
- if ($> == 0) {
- die "Won't run as root.\n";
- }
-
- #
- # Check some file permissions
- #
- if (! -d $::DB_DIR or ! -w $::DB_DIR or (sprintf "%04o", ((stat ($::DB_DIR))[2]) & 07777) ne '0700') {
- die "$::DB_DIR must exist, be writable and have mode 0700.\n";
- }
- if (! -d "$::DB_DIR/cache") {
- mkdir ("$::DB_DIR/cache", 0700) or die "mkdir (\"$::DB_DIR/cache\", 0700): $!\n";
- }
- if (! -d $::DIRECTORY or ! -w $::DIRECTORY or (sprintf "%04o", ((stat ($::DIRECTORY))[2]) & 07777) ne '0750') {
- die "$::DIRECTORY must exist, be writable and have mode 0750.\n";
- }
-
- #
- # Read in wcal.msg
- #
- open(MSG, $::MSG_FILE) or die "Can't open $::MSG_FILE for reading: $!";
- my $old_slash = $/;
- undef $/;
- $::msgs = eval (<MSG>);
- $/ = $old_slash;
- close(MSG);
-
- #
- # Read configuration and create users
- #
- $config_result = read_config ();
- if (ref $config_result) {
- die "$0: error: ", $$config_result, "\n";
- }
- $res = create_users ();
- if ($res) {
- die "$0: error creating users: $res\n";
- }
-
- #
- # Make sure current database (if one exists) uses same 'first day'
- # parameter as we're currently using.
- #
- check_and_set_first_day ();
-
- #
- # Set the date constants
- #
- if ($::FIRST_DAY eq 'monday') {
- @::weekdays = qw (Lundi Mardi Mercredi Jeudi Vendredi Samedi Dimanche);
- @::weekdays_short = qw (lun mar mer jeu ven sam dim);
- @::weekdays2 = qw (Monday Tuesday Wednesday Thursday Friday Saturday Sunday);
- &Date_Init ('FirstDay=1');
- } else {
- @::weekdays = qw (Dimanche Lundi Mardi Mercredi Jeudi Vendredi Samedi);
- @::weekdays_short = qw (dim lun mar mer jeu ven sam);
- @::weekdays2 = qw (Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
- &Date_Init ('FirstDay=7');
- }
- @::months = qw (Erreur Janvier Février Mars Avril Mai Juin Juillet Août Septembre Octobre Novembre Décembre);
-
- init_socket ();
-
- $last_run = (localtime(time))[7];
- $last_conf = 0;
-
- while (1) {
- my ($query_type, $pid, $paddr, $cgi, %user, $now_run, $now_conf);
-
- $SIG{'INT'} = $SIG{'TERM'} = \&siginthandler;
- $SIG{'HUP'} = \&sighuphandler;
- $paddr = accept (Socket, SSocket);
- $SIG{'INT'} = $SIG{'TERM'} = $SIG{'HUP'} = 'IGNORE';
-
- #
- # Purge cache when day changes
- #
- $now_run = (localtime(time))[7];
- if ($now_run != $last_run) {
- $last_run = $now_run;
- purge_cache_newday ();
- }
-
- #
- # Start outputing HTML
- #
- print Socket $::HTTP_HEADER;
- print Socket "<HTML>\n";
-
- #
- # Read CGI environment and the config options that cgi-proxy passes to us
- # Includes QUERY_STRING (decoded into $::query),
- # __password (checked) and __user (stored in $::USER)
- #
- if (! read_environment ()) {
- next;
- }
-
- #
- # Re-read config if it has changed
- #
- $now_conf = (stat($::CONF_FILE))[9];
- if ($now_conf != $last_conf) {
- $last_conf = $now_conf;
- $config_result = read_config ();
- if (ref $config_result) {
- while (<Socket>) { chomp; last if /^$/; }; # Read environment to make cgi-proxy happy
- print Socket $::H_BODY;
- print Socket "<P><H2>Configuration has changed.</H2>";
- print Socket "<P>Re-reading configureation failed: ", $$config_result, " - configuration not changed.\n";
- print Socket "<P><A TARGET=\"_top\" HREF=\"$::BASE_URL/\">Click me</A> to go to the main view\n";
- print Socket "</BODY>\n";
- next;
- } else {
- $res = create_users ();
- if ($res) {
- print Socket $::H_BODY;
- print Socket "<P><H2>Configuration has changed.</H2>";
- print Socket "<P>Error creating new users: $res\n";
- print Socket "<P><A TARGET=\"_top\" HREF=\"$::BASE_URL/\">Click me</A> to go to the main view\n";
- print Socket "</BODY>\n";
- next;
- }
- # fall through: just serve the request
- }
- }
-
- # show a list of users
- if (!$::query->{'cal'} && $::USER eq $::PATH_BASENAME) {
- list_users ();
- next;
- }
-
- #
- # Dispatch the operation
- #
-
- # Make sure the users exists
- if ($::USER_CONFS->{$::USER}) {
- import_settings ($::USER_CONFS->{$::USER});
- $::DATA_IDS = 0;
- }
- else # fusion
- {
- $::READ_ONLY = 'true';
- $::DATA_ID = 0;
- $::DATA_IDS = $::query->{'cal'};
- $::LONG_NAME = __('Fusion');
- $::MY_URL = $::BASE_URL.'/fusion.cgi';
- $::MY_URL_XUSER = $::BASE_URL.'/fusion.cgi';
- }
-
- $::query->{'u'} = $::USER;
- $query_type = $::query->{'t'} || '';
- if ($query_type eq 'redraw' or $query_type eq '') {
- redraw ();
- } elsif ($query_type eq 'week') {
- show_week ();
- } elsif ($query_type eq 'day') {
- show_day ();
- } elsif ($query_type eq 'event') {
- show_event ();
- } elsif ($query_type eq 'copy_event') {
- copy_event ();
- } elsif ($query_type eq 'add_edit') {
- add_edit_event_ask () if check_write_access ();
- } elsif ($query_type eq 'add_edit_confirm') {
- add_edit_event_confirm () if check_write_access ();
- } elsif ($query_type eq 'remove') {
- remove_event_confirm () if check_write_access ();
- } elsif ($query_type eq 'xxx_event_error') {
- xxx_event_error ();
- } elsif ($query_type eq 'event_list') {
- show_event_list ();
- } elsif ($query_type eq 'views') {
- show_other_views ();
- } elsif ($query_type eq 'links') {
- show_links ();
- } elsif ($query_type eq 'purge') {
- show_purge ();
- } elsif ($query_type eq 'checkalarm') {
- check_alarm ();
- } else {
- print Socket "<H2><P>Unknown command '$query_type'.</H2>\n";
- }
- undef $::query;
-
- } continue {
- print Socket "</HTML>\n";
- close Socket;
- }
-
- # not reached
-}
-
-main();
generated by cgit v1.2.3 (git 2.39.1) at 2024-04-25 19:13:12 +0000